annotate src/data.c @ 69935:3fc0524ae318

(unload-feature): A bit of sanity check of load-history entries. Cancel timer-vars before unbinding them.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Tue, 11 Apr 2006 17:05:16 +0000
parents 56d8e0539545
children d1cea7530d3d 24cf4bf418dc c156f6a9e7b5
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.
64770
a0d1312ede66 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64084
diff changeset
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
68651
3bd95f4f2941 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68497
diff changeset
3 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5 This file is part of GNU Emacs.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 GNU Emacs is free software; you can redistribute it and/or modify
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 it under the terms of the GNU General Public License as published by
12244
ac7375e60931 Update GPL to version 2.
Karl Heuer <kwzh@gnu.org>
parents: 12225
diff changeset
9 the Free Software Foundation; either version 2, or (at your option)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10 any later version.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 GNU Emacs is distributed in the hope that it will be useful,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 GNU General Public License for more details.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 along with GNU Emacs; see the file COPYING. If not, write to
64084
a8fa7c632ee4 Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 61888
diff changeset
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
a8fa7c632ee4 Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 61888
diff changeset
20 Boston, MA 02110-1301, USA. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 25780
diff changeset
23 #include <config.h>
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 #include <signal.h>
25780
18cf58ed9400 (find_symbol_value): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents: 25665
diff changeset
25 #include <stdio.h>
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26 #include "lisp.h"
336
25114d2b73e3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 298
diff changeset
27 #include "puresize.h"
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
28 #include "charset.h"
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 #include "buffer.h"
11341
e0f3fa4e7bf3 Include keyboard.h.
Richard M. Stallman <rms@gnu.org>
parents: 11239
diff changeset
30 #include "keyboard.h"
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
31 #include "frame.h"
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
2781
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2647
diff changeset
34 #ifdef STDC_HEADERS
20122
923e1f635ace No need to include <float.h> before "lisp.h",
Paul Eggert <eggert@twinsun.com>
parents: 20055
diff changeset
35 #include <float.h>
2781
fde05936aebb * lread.c, data.c: If STDC_HEADERS is #defined, include <stdlib.h>
Jim Blandy <jimb@redhat.com>
parents: 2647
diff changeset
36 #endif
4860
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
37
16787
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
38 /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
39 #ifndef IEEE_FLOATING_POINT
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
40 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
41 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
42 #define IEEE_FLOATING_POINT 1
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
43 #else
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
44 #define IEEE_FLOATING_POINT 0
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
45 #endif
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
46 #endif
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
47
4860
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
48 /* Work around a problem that happens because math.h on hpux 7
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
49 defines two static variables--which, in Emacs, are not really static,
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
50 because `static' is defined as nothing. The problem is that they are
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
51 here, in floatfns.c, and in lread.c.
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
52 These macros prevent the name conflict. */
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
53 #if defined (HPUX) && !defined (HPUX8)
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
54 #define _MAXLDBL data_c_maxldbl
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
55 #define _NMAXLDBL data_c_nmaxldbl
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
56 #endif
ff23fe23f58c [hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents: 4780
diff changeset
57
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58 #include <math.h>
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;
39767
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
68 Lisp_Object Qcyclic_variable_indirection, Qcircular_list;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69 Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
70 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
4036
fbbd3e138284 Define Qmark_inactive.
Roland McGrath <roland@gnu.org>
parents: 3675
diff changeset
71 Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
26274
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
73 Lisp_Object Qtext_read_only;
53110
369a7f9f7dc2 (Qinteger): Exported.
Lars Hansen <larsh@soem.dk>
parents: 52938
diff changeset
74
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
75 Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
77 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
26931
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
78 Lisp_Object Qbuffer_or_string_p, Qkeywordp;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
79 Lisp_Object Qboundp, Qfboundp;
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
80 Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
81
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 Lisp_Object Qcdr;
26205
65a0abaeed68 (Qad_activate_internal): Renamed from Qad_activate.
Gerd Moellmann <gerd@gnu.org>
parents: 26185
diff changeset
83 Lisp_Object Qad_advice_info, Qad_activate_internal;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
85 Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
86 Lisp_Object Qoverflow_error, Qunderflow_error;
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
87
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
88 Lisp_Object Qfloatp;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 Lisp_Object Qnumberp, Qnumber_or_marker_p;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90
53110
369a7f9f7dc2 (Qinteger): Exported.
Lars Hansen <larsh@soem.dk>
parents: 52938
diff changeset
91 Lisp_Object Qinteger;
369a7f9f7dc2 (Qinteger): Exported.
Lars Hansen <larsh@soem.dk>
parents: 52938
diff changeset
92 static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
93 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
94 Lisp_Object Qprocess;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
95 static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
26185
be223f84693c (Qhash_table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
96 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
29237
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
97 static Lisp_Object Qsubrp, Qmany, Qunevalled;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
98
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
99 static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
17830
3cf4a044aaad Declare set_internal as Lisp_Object in advance to avoid
Kenichi Handa <handa@m17n.org>
parents: 17780
diff changeset
100
41865
f5dbdfc9fe27 (Vmost_positive_fixnum, Vmost_negative_fixnum): Renamed
Andreas Schwab <schwab@suse.de>
parents: 41153
diff changeset
101 Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum;
39632
8cd74f2aa6e2 (most_positive_fixnum, most_negative_fixnum): New
Gerd Moellmann <gerd@gnu.org>
parents: 39575
diff changeset
102
39767
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
103
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
104 void
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
105 circular_list_error (list)
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
106 Lisp_Object list;
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
107 {
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
108 Fsignal (Qcircular_list, list);
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
109 }
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
110
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
111
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 wrong_type_argument (predicate, value)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114 register Lisp_Object predicate, value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 register Lisp_Object tem;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 do
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118 {
10245
f0637b2f1671 (wrong_type_argument): Abort if VALUE is invalid Lisp object.
Richard M. Stallman <rms@gnu.org>
parents: 9966
diff changeset
119 /* 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
120 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
121 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
122 abort ();
f0637b2f1671 (wrong_type_argument): Abort if VALUE is invalid Lisp object.
Richard M. Stallman <rms@gnu.org>
parents: 9966
diff changeset
123
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125 tem = call1 (predicate, value);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 }
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
127 while (NILP (tem));
69928
56d8e0539545 * lisp.h (wrong_type_argument): Mark as NO_RETURN.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 68780
diff changeset
128 /* This function is marked as NO_RETURN, gcc would warn if it has a
56d8e0539545 * lisp.h (wrong_type_argument): Mark as NO_RETURN.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 68780
diff changeset
129 return statement or if falls off the function. Other compilers
56d8e0539545 * lisp.h (wrong_type_argument): Mark as NO_RETURN.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 68780
diff changeset
130 warn if no return statement is present. */
56d8e0539545 * lisp.h (wrong_type_argument): Mark as NO_RETURN.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 68780
diff changeset
131 #ifndef __GNUC__
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 return value;
69928
56d8e0539545 * lisp.h (wrong_type_argument): Mark as NO_RETURN.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 68780
diff changeset
133 #else
56d8e0539545 * lisp.h (wrong_type_argument): Mark as NO_RETURN.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 68780
diff changeset
134 abort ();
56d8e0539545 * lisp.h (wrong_type_argument): Mark as NO_RETURN.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 68780
diff changeset
135 #endif
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21476
diff changeset
138 void
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 pure_write_error ()
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 error ("Attempt to modify read-only object");
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 void
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 args_out_of_range (a1, a2)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 Lisp_Object a1, a2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil)));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152 void
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 args_out_of_range_3 (a1, a2, a3)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154 Lisp_Object a1, a2, a3;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
155 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
157 Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil))));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 /* On some machines, XINT needs a temporary location.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 Here it is, in case it is needed. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163 int sign_extend_temp;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
164
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 /* On a few machines, XINT can only be done by calling this. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167 int
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 sign_extend_lisp_int (num)
8820
f68749766ed1 (sign_extend_lisp_int): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 8798
diff changeset
169 EMACS_INT num;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 {
8820
f68749766ed1 (sign_extend_lisp_int): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 8798
diff changeset
171 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
172 return num | (((EMACS_INT) (-1)) << VALBITS);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 else
8820
f68749766ed1 (sign_extend_lisp_int): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 8798
diff changeset
174 return num & ((((EMACS_INT) 1) << VALBITS) - 1);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177 /* Data type predicates */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
179 DEFUN ("eq", Feq, Seq, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
180 doc: /* Return t if the two args are the same Lisp object. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
181 (obj1, obj2)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 Lisp_Object obj1, obj2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 if (EQ (obj1, obj2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
188
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
189 DEFUN ("null", Fnull, Snull, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
190 doc: /* Return t if OBJECT is nil. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
191 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
192 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
194 if (NILP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
196 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
199 DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
200 doc: /* Return a symbol representing the type of OBJECT.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
201 The symbol returned names the object's basic type;
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
202 for example, (type-of 1) returns `integer'. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
203 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
204 Lisp_Object object;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
205 {
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
206 switch (XGCTYPE (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
207 {
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
208 case Lisp_Int:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
209 return Qinteger;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
210
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
211 case Lisp_Symbol:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
212 return Qsymbol;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
213
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
214 case Lisp_String:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
215 return Qstring;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
216
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
217 case Lisp_Cons:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
218 return Qcons;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
219
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
220 case Lisp_Misc:
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
221 switch (XMISCTYPE (object))
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
222 {
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
223 case Lisp_Misc_Marker:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
224 return Qmarker;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
225 case Lisp_Misc_Overlay:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
226 return Qoverlay;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
227 case Lisp_Misc_Float:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
228 return Qfloat;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
229 }
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
230 abort ();
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
231
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
232 case Lisp_Vectorlike:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
233 if (GC_WINDOW_CONFIGURATIONP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
234 return Qwindow_configuration;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
235 if (GC_PROCESSP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
236 return Qprocess;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
237 if (GC_WINDOWP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
238 return Qwindow;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
239 if (GC_SUBRP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
240 return Qsubr;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
241 if (GC_COMPILEDP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
242 return Qcompiled_function;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
243 if (GC_BUFFERP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
244 return Qbuffer;
13715
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
245 if (GC_CHAR_TABLE_P (object))
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
246 return Qchar_table;
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
247 if (GC_BOOL_VECTOR_P (object))
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
248 return Qbool_vector;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
249 if (GC_FRAMEP (object))
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
250 return Qframe;
26185
be223f84693c (Qhash_table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
251 if (GC_HASH_TABLE_P (object))
be223f84693c (Qhash_table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
252 return Qhash_table;
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
253 return Qvector;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
254
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
255 case Lisp_Float:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
256 return Qfloat;
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
257
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
258 default:
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
259 abort ();
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
260 }
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
261 }
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
262
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
263 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
264 doc: /* Return t if OBJECT is a cons cell. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
265 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
266 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
267 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
268 if (CONSP (object))
298
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 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
271 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
272
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
273 DEFUN ("atom", Fatom, Satom, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
274 doc: /* Return t if OBJECT is not a cons cell. This includes nil. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
275 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
276 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
277 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
278 if (CONSP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
283 DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
68497
a224550f3e25 (Flistp): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68446
diff changeset
284 doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
a224550f3e25 (Flistp): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68446
diff changeset
285 Otherwise, return nil. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
286 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
287 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
289 if (CONSP (object) || NILP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
293
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
294 DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
295 doc: /* Return t if OBJECT is not a list. Lists include nil. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
296 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
297 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
298 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
299 if (CONSP (object) || NILP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
300 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
304 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
305 doc: /* Return t if OBJECT is a symbol. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
306 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
307 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
308 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
309 if (SYMBOLP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313
26931
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
314 /* Define this in C to avoid unnecessarily consing up the symbol
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
315 name. */
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
316 DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
317 doc: /* Return t if OBJECT is a keyword.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
318 This means that it is a symbol with a print name beginning with `:'
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
319 interned in the initial obarray. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
320 (object)
26931
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
321 Lisp_Object object;
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
322 {
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
323 if (SYMBOLP (object)
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
324 && SREF (SYMBOL_NAME (object), 0) == ':'
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
325 && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))
26931
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
326 return Qt;
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
327 return Qnil;
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
328 }
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
329
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
330 DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
331 doc: /* Return t if OBJECT is a vector. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
332 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
333 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
335 if (VECTORP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
336 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
337 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
338 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
339
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
340 DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
341 doc: /* Return t if OBJECT is a string. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
342 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
343 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
344 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
345 if (STRINGP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
346 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
347 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
348 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
349
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
350 DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
351 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
352 doc: /* Return t if OBJECT is a multibyte string. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
353 (object)
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
354 Lisp_Object object;
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
355 {
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
356 if (STRINGP (object) && STRING_MULTIBYTE (object))
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
357 return Qt;
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
358 return Qnil;
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
359 }
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
360
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
361 DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
362 doc: /* Return t if OBJECT is a char-table. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
363 (object)
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
364 Lisp_Object object;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
365 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
366 if (CHAR_TABLE_P (object))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
367 return Qt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
368 return Qnil;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
369 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
370
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
371 DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
372 Svector_or_char_table_p, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
373 doc: /* Return t if OBJECT is a char-table or vector. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
374 (object)
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
375 Lisp_Object object;
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
376 {
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
377 if (VECTORP (object) || CHAR_TABLE_P (object))
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
378 return Qt;
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
379 return Qnil;
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
380 }
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
381
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
382 DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
383 doc: /* Return t if OBJECT is a bool-vector. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
384 (object)
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
385 Lisp_Object object;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
386 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
387 if (BOOL_VECTOR_P (object))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
388 return Qt;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
389 return Qnil;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
390 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
391
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
392 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
393 doc: /* Return t if OBJECT is an array (string or vector). */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
394 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
395 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396 {
18045
a2029aaffb4f (Farrayp): Accept bool-vectors and char-tables.
Richard M. Stallman <rms@gnu.org>
parents: 18011
diff changeset
397 if (VECTORP (object) || STRINGP (object)
a2029aaffb4f (Farrayp): Accept bool-vectors and char-tables.
Richard M. Stallman <rms@gnu.org>
parents: 18011
diff changeset
398 || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
403 DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
404 doc: /* Return t if OBJECT is a sequence (list or array). */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
405 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
406 register Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 {
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
408 if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
409 || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
414 DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
415 doc: /* Return t if OBJECT is an editor buffer. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
416 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
417 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
419 if (BUFFERP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
423
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
424 DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
425 doc: /* Return t if OBJECT is a marker (editor pointer). */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
426 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
427 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
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 (MARKERP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
434 DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
435 doc: /* Return t if OBJECT is a built-in function. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
436 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
437 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
439 if (SUBRP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
444 DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
445 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
446 doc: /* Return t if OBJECT is a byte-compiled function object. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
447 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
448 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
449 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
450 if (COMPILEDP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
452 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454
6385
e81e7c424e8a (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6201
diff changeset
455 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
456 doc: /* Return t if OBJECT is a character (an integer) or a string. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
457 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
458 register Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
459 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
460 if (INTEGERP (object) || STRINGP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
461 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
462 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
465 DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
466 doc: /* Return t if OBJECT is an integer. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
467 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
468 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
469 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
470 if (INTEGERP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
471 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
473 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
474
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
475 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
476 doc: /* Return t if OBJECT is an integer or a marker (editor pointer). */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
477 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
478 register Lisp_Object object;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
479 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
480 if (MARKERP (object) || INTEGERP (object))
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
481 return Qt;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
482 return Qnil;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
483 }
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
484
6385
e81e7c424e8a (Fchar_or_string_p, Fintegerp, Fnatnump): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6201
diff changeset
485 DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
486 doc: /* Return t if OBJECT is a nonnegative integer. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
487 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
488 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
490 if (NATNUMP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
492 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
495 DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
496 doc: /* Return t if OBJECT is a number (floating point or integer). */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
497 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
498 Lisp_Object object;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
499 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
500 if (NUMBERP (object))
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
501 return Qt;
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
502 else
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
503 return Qnil;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
504 }
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
505
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
506 DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
507 Snumber_or_marker_p, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
508 doc: /* Return t if OBJECT is a number or a marker. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
509 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
510 Lisp_Object object;
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
511 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
512 if (NUMBERP (object) || MARKERP (object))
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
513 return Qt;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
514 return Qnil;
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
515 }
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
516
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517 DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
518 doc: /* Return t if OBJECT is a floating point number. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
519 (object)
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
520 Lisp_Object object;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 {
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
522 if (FLOATP (object))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 }
27727
9400865ec7cf Remove `LISP_FLOAT_TYPE' and `standalone'.
Gerd Moellmann <gerd@gnu.org>
parents: 27703
diff changeset
526
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 /* Extract and set components of lists */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 DEFUN ("car", Fcar, Scar, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
531 doc: /* Return the car of LIST. If arg is nil, return nil.
68444
3eb2a97faeda (Fcar, Fcdr): Add links to Elisp manual to the docstrings.
Luc Teirlinck <teirllm@auburn.edu>
parents: 66542
diff changeset
532 Error if arg is not nil and not a cons cell. See also `car-safe'.
3eb2a97faeda (Fcar, Fcdr): Add links to Elisp manual to the docstrings.
Luc Teirlinck <teirllm@auburn.edu>
parents: 66542
diff changeset
533
68446
8ad0f8c7115f (Fcar, Fcdr): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68444
diff changeset
534 See Info node `(elisp)Cons Cells' for a discussion of related basic
8ad0f8c7115f (Fcar, Fcdr): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68444
diff changeset
535 Lisp concepts such as car, cdr, cons cell and list. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
536 (list)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537 register Lisp_Object list;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
540 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
541 if (CONSP (list))
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
542 return XCAR (list);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
543 else if (EQ (list, Qnil))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
545 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546 list = wrong_type_argument (Qlistp, list);
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
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550 DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
551 doc: /* Return the car of OBJECT if it is a cons cell, or else nil. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
552 (object)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
553 Lisp_Object object;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
555 if (CONSP (object))
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
556 return XCAR (object);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
562 doc: /* Return the cdr of LIST. If arg is nil, return nil.
68444
3eb2a97faeda (Fcar, Fcdr): Add links to Elisp manual to the docstrings.
Luc Teirlinck <teirllm@auburn.edu>
parents: 66542
diff changeset
563 Error if arg is not nil and not a cons cell. See also `cdr-safe'.
3eb2a97faeda (Fcar, Fcdr): Add links to Elisp manual to the docstrings.
Luc Teirlinck <teirllm@auburn.edu>
parents: 66542
diff changeset
564
68446
8ad0f8c7115f (Fcar, Fcdr): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68444
diff changeset
565 See Info node `(elisp)Cons Cells' for a discussion of related basic
8ad0f8c7115f (Fcar, Fcdr): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68444
diff changeset
566 Lisp concepts such as cdr, car, cons cell and list. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
567 (list)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 register Lisp_Object list;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570 while (1)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
571 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
572 if (CONSP (list))
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
573 return XCDR (list);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 else if (EQ (list, Qnil))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
576 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
577 list = wrong_type_argument (Qlistp, list);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
578 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
579 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
580
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
581 DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
582 doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
583 (object)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
584 Lisp_Object object;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
585 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
586 if (CONSP (object))
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
587 return XCDR (object);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
588 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
593 doc: /* Set the car of CELL to be NEWCAR. Returns NEWCAR. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
594 (cell, newcar)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 register Lisp_Object cell, newcar;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
597 if (!CONSP (cell))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
598 cell = wrong_type_argument (Qconsp, cell);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
599
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 CHECK_IMPURE (cell);
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
601 XSETCAR (cell, newcar);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
602 return newcar;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
604
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
605 DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
606 doc: /* Set the cdr of CELL to be NEWCDR. Returns NEWCDR. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
607 (cell, newcdr)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
608 register Lisp_Object cell, newcdr;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
609 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
610 if (!CONSP (cell))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
611 cell = wrong_type_argument (Qconsp, cell);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
612
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
613 CHECK_IMPURE (cell);
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
614 XSETCDR (cell, newcdr);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
615 return newcdr;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
616 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
617
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
618 /* Extract and set components of symbols */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
619
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
620 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
621 doc: /* Return t if SYMBOL's value is not void. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
622 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
623 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
624 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
625 Lisp_Object valcontents;
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
626 CHECK_SYMBOL (symbol);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
627
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
628 valcontents = SYMBOL_VALUE (symbol);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
629
9889
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
630 if (BUFFER_LOCAL_VALUEP (valcontents)
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
631 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
632 valcontents = swap_in_symval_forwarding (symbol, valcontents);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
633
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
634 return (EQ (valcontents, Qunbound) ? Qnil : Qt);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
635 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
636
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
637 DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
638 doc: /* Return t if SYMBOL's function definition is not void. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
639 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
640 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
641 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
642 CHECK_SYMBOL (symbol);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
643 return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
644 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
645
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
646 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
647 doc: /* Make SYMBOL's value be void.
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
648 Return SYMBOL. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
649 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
650 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
651 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
652 CHECK_SYMBOL (symbol);
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
653 if (XSYMBOL (symbol)->constant)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
654 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
655 Fset (symbol, Qunbound);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
656 return symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
657 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
658
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
659 DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
660 doc: /* Make SYMBOL's function definition be void.
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
661 Return SYMBOL. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
662 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
663 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
664 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
665 CHECK_SYMBOL (symbol);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
666 if (NILP (symbol) || EQ (symbol, Qt))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
667 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
668 XSYMBOL (symbol)->function = Qunbound;
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
669 return symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
670 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
671
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
672 DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
673 doc: /* Return SYMBOL's function definition. Error if that is void. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
674 (symbol)
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
675 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
676 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
677 CHECK_SYMBOL (symbol);
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
678 if (EQ (XSYMBOL (symbol)->function, Qunbound))
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
679 return Fsignal (Qvoid_function, Fcons (symbol, Qnil));
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
680 return XSYMBOL (symbol)->function;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
681 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
682
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
683 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
684 doc: /* Return SYMBOL's property list. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
685 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
686 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
687 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
688 CHECK_SYMBOL (symbol);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
689 return XSYMBOL (symbol)->plist;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
690 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
691
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
692 DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
693 doc: /* Return SYMBOL's name, a string. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
694 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
695 register Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
696 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 register Lisp_Object name;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
698
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
699 CHECK_SYMBOL (symbol);
45397
bc5d63652a0a * data.c (Fkeywordp, Fsymbol_name, store_symval_forwarding)
Ken Raeburn <raeburn@raeburn.org>
parents: 42274
diff changeset
700 name = SYMBOL_NAME (symbol);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
701 return name;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
702 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
705 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
706 (symbol, definition)
16754
6ca8ed287a53 (Ffset): Change argument name and doc string.
Richard M. Stallman <rms@gnu.org>
parents: 16434
diff changeset
707 register Lisp_Object symbol, definition;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
708 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
709 CHECK_SYMBOL (symbol);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
710 if (NILP (symbol) || EQ (symbol, Qt))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
711 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
712 if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound))
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
713 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
714 Vautoload_queue);
16754
6ca8ed287a53 (Ffset): Change argument name and doc string.
Richard M. Stallman <rms@gnu.org>
parents: 16434
diff changeset
715 XSYMBOL (symbol)->function = definition;
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
716 /* Handle automatic advice activation */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
717 if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
718 {
26205
65a0abaeed68 (Qad_activate_internal): Renamed from Qad_activate.
Gerd Moellmann <gerd@gnu.org>
parents: 26185
diff changeset
719 call2 (Qad_activate_internal, symbol, Qnil);
16754
6ca8ed287a53 (Ffset): Change argument name and doc string.
Richard M. Stallman <rms@gnu.org>
parents: 16434
diff changeset
720 definition = XSYMBOL (symbol)->function;
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
721 }
16754
6ca8ed287a53 (Ffset): Change argument name and doc string.
Richard M. Stallman <rms@gnu.org>
parents: 16434
diff changeset
722 return definition;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
723 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724
46279
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
725 extern Lisp_Object Qfunction_documentation;
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
726
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
727 DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
728 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
46521
84a08db3c1e6 (Fdefalias): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 46422
diff changeset
729 Associates the function with the current load file, if any.
84a08db3c1e6 (Fdefalias): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 46422
diff changeset
730 The optional third argument DOCSTRING specifies the documentation string
84a08db3c1e6 (Fdefalias): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 46422
diff changeset
731 for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
84a08db3c1e6 (Fdefalias): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 46422
diff changeset
732 determined by DEFINITION. */)
46279
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
733 (symbol, definition, docstring)
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
734 register Lisp_Object symbol, definition, docstring;
2548
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
735 {
65600
bd15c2b64526 (Fdefalias): Signal an error if SYMBOL is not a symbol.
John Paul Wallington <jpw@pobox.com>
parents: 64770
diff changeset
736 CHECK_SYMBOL (symbol);
48723
a6906c113d14 (Fdefalias): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
parents: 47276
diff changeset
737 if (CONSP (XSYMBOL (symbol)->function)
a6906c113d14 (Fdefalias): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
parents: 47276
diff changeset
738 && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
a6906c113d14 (Fdefalias): Record in load-history redefining an autoload.
Richard M. Stallman <rms@gnu.org>
parents: 47276
diff changeset
739 LOADHIST_ATTACH (Fcons (Qt, symbol));
25132
07b44154638f (Fdefalias): Call Ffset instead of duplicating code.
Karl Heuer <kwzh@gnu.org>
parents: 23602
diff changeset
740 definition = Ffset (symbol, definition);
59110
5feed0f86f52 (Fdefalias): Use (defun . FN_NAME) in LOADHIST_ATTACH.
Richard M. Stallman <rms@gnu.org>
parents: 58986
diff changeset
741 LOADHIST_ATTACH (Fcons (Qdefun, symbol));
46279
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
742 if (!NILP (docstring))
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
743 Fput (symbol, Qfunction_documentation, docstring);
16756
71113ba79b1b (Fdefalias): Change argument name and doc string.
Richard M. Stallman <rms@gnu.org>
parents: 16754
diff changeset
744 return definition;
2548
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
745 }
b66eeded6afc (Fdefine_function): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
746
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
747 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
52938
2d50b0e7a79c (Fsetplist): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 52537
diff changeset
748 doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
749 (symbol, newplist)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
750 register Lisp_Object symbol, newplist;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
751 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
752 CHECK_SYMBOL (symbol);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
753 XSYMBOL (symbol)->plist = newplist;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
754 return newplist;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
755 }
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
756
29237
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
757 DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
758 doc: /* Return minimum and maximum number of args allowed for SUBR.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
759 SUBR must be a built-in function.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
760 The returned value is a pair (MIN . MAX). MIN is the minimum number
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
761 of args. MAX is the maximum number or the symbol `many', for a
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
762 function with `&rest' args, or `unevalled' for a special form. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
763 (subr)
29237
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
764 Lisp_Object subr;
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
765 {
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
766 short minargs, maxargs;
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
767 if (!SUBRP (subr))
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
768 wrong_type_argument (Qsubrp, subr);
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
769 minargs = XSUBR (subr)->min_args;
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
770 maxargs = XSUBR (subr)->max_args;
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
771 if (maxargs == MANY)
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
772 return Fcons (make_number (minargs), Qmany);
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
773 else if (maxargs == UNEVALLED)
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
774 return Fcons (make_number (minargs), Qunevalled);
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
775 else
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
776 return Fcons (make_number (minargs), make_number (maxargs));
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
777 }
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
778
55230
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
779 DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
780 doc: /* Return name of subroutine SUBR.
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
781 SUBR must be a built-in function. */)
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
782 (subr)
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
783 Lisp_Object subr;
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
784 {
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
785 const char *name;
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
786 if (!SUBRP (subr))
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
787 wrong_type_argument (Qsubrp, subr);
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
788 name = XSUBR (subr)->symbol_name;
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
789 return make_string (name, strlen (name));
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
790 }
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
791
54627
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
792 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
793 doc: /* Return the interactive form of CMD or nil if none.
56590
f48e32fbfc6c (Finteractive_form): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56193
diff changeset
794 If CMD is not a command, the return value is nil.
f48e32fbfc6c (Finteractive_form): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56193
diff changeset
795 Value, if non-nil, is a list \(interactive SPEC). */)
54627
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
796 (cmd)
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
797 Lisp_Object cmd;
37053
1a420f3df4f8 (Fsubr_interactive_form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 36819
diff changeset
798 {
54627
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
799 Lisp_Object fun = indirect_function (cmd);
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
800
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
801 if (SUBRP (fun))
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
802 {
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
803 if (XSUBR (fun)->prompt)
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
804 return list2 (Qinteractive, build_string (XSUBR (fun)->prompt));
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
805 }
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
806 else if (COMPILEDP (fun))
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
807 {
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
808 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
809 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
810 }
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
811 else if (CONSP (fun))
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
812 {
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
813 Lisp_Object funcar = XCAR (fun);
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
814 if (EQ (funcar, Qlambda))
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
815 return Fassq (Qinteractive, Fcdr (XCDR (fun)));
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
816 else if (EQ (funcar, Qautoload))
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
817 {
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
818 struct gcpro gcpro1;
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
819 GCPRO1 (cmd);
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
820 do_autoload (fun, cmd);
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
821 UNGCPRO;
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
822 return Finteractive_form (cmd);
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
823 }
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
824 }
37053
1a420f3df4f8 (Fsubr_interactive_form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 36819
diff changeset
825 return Qnil;
1a420f3df4f8 (Fsubr_interactive_form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 36819
diff changeset
826 }
1a420f3df4f8 (Fsubr_interactive_form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 36819
diff changeset
827
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
828
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
829 /***********************************************************************
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
830 Getting and Setting Values of Symbols
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
831 ***********************************************************************/
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
832
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
833 /* Return the symbol holding SYMBOL's value. Signal
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
834 `cyclic-variable-indirection' if SYMBOL's chain of variable
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
835 indirections contains a loop. */
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
836
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
837 Lisp_Object
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
838 indirect_variable (symbol)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
839 Lisp_Object symbol;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
840 {
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
841 Lisp_Object tortoise, hare;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
842
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
843 hare = tortoise = symbol;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
844
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
845 while (XSYMBOL (hare)->indirect_variable)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
846 {
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
847 hare = XSYMBOL (hare)->value;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
848 if (!XSYMBOL (hare)->indirect_variable)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
849 break;
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
850
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
851 hare = XSYMBOL (hare)->value;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
852 tortoise = XSYMBOL (tortoise)->value;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
853
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
854 if (EQ (hare, tortoise))
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
855 Fsignal (Qcyclic_variable_indirection, Fcons (symbol, Qnil));
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
856 }
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
857
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
858 return hare;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
859 }
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
860
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
861
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
862 DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
863 doc: /* Return the variable at the end of OBJECT's variable chain.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
864 If OBJECT is a symbol, follow all variable indirections and return the final
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
865 variable. If OBJECT is not a symbol, just return it.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
866 Signal a cyclic-variable-indirection error if there is a loop in the
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
867 variable chain of symbols. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
868 (object)
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
869 Lisp_Object object;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
870 {
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
871 if (SYMBOLP (object))
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
872 object = indirect_variable (object);
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
873 return object;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
874 }
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
875
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
876
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
877 /* Given the raw contents of a symbol value cell,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
878 return the Lisp value of the symbol.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
879 This does not handle buffer-local variables; use
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
880 swap_in_symval_forwarding for that. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
881
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
882 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
883 do_symval_forwarding (valcontents)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
884 register Lisp_Object valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
885 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
886 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
887 int offset;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
888 if (MISCP (valcontents))
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
889 switch (XMISCTYPE (valcontents))
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
890 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
891 case Lisp_Misc_Intfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
892 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
893 return val;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
894
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
895 case Lisp_Misc_Boolfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
896 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
897
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
898 case Lisp_Misc_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
899 return *XOBJFWD (valcontents)->objvar;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
900
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
901 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
902 offset = XBUFFER_OBJFWD (valcontents)->offset;
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
903 return PER_BUFFER_VALUE (current_buffer, offset);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
904
11019
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
905 case Lisp_Misc_Kboard_Objfwd:
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
906 offset = XKBOARD_OBJFWD (valcontents)->offset;
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
907 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
908 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
909 return valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
910 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
911
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
912 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
913 of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
914 buffer-independent contents of the value cell: forwarded just one
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
915 step past the buffer-localness.
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
916
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
917 BUF non-zero means set the value in buffer BUF instead of the
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
918 current buffer. This only plays a role for per-buffer variables. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
919
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
920 void
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
921 store_symval_forwarding (symbol, valcontents, newval, buf)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
922 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
923 register Lisp_Object valcontents, newval;
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
924 struct buffer *buf;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
925 {
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
926 switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
927 {
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
928 case Lisp_Misc:
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
929 switch (XMISCTYPE (valcontents))
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
930 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
931 case Lisp_Misc_Intfwd:
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
932 CHECK_NUMBER (newval);
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
933 *XINTFWD (valcontents)->intvar = XINT (newval);
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
934 if (*XINTFWD (valcontents)->intvar != XINT (newval))
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
935 error ("Value out of range for variable `%s'",
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
936 SDATA (SYMBOL_NAME (symbol)));
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
937 break;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
938
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
939 case Lisp_Misc_Boolfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
940 *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
941 break;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
942
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
943 case Lisp_Misc_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
944 *XOBJFWD (valcontents)->objvar = newval;
53365
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
945
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
946 /* If this variable is a default for something stored
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
947 in the buffer itself, such as default-fill-column,
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
948 find the buffers that don't have local values for it
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
949 and update them. */
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
950 if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
951 && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
952 {
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
953 int offset = ((char *) XOBJFWD (valcontents)->objvar
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
954 - (char *) &buffer_defaults);
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
955 int idx = PER_BUFFER_IDX (offset);
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
956
58086
4de4892b2b6c (store_symval_forwarding): Remove unused variables.
Kim F. Storm <storm@cua.dk>
parents: 57726
diff changeset
957 Lisp_Object tail;
53365
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
958
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
959 if (idx <= 0)
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
960 break;
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
961
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
962 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
963 {
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
964 Lisp_Object buf;
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
965 struct buffer *b;
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
966
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
967 buf = Fcdr (XCAR (tail));
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
968 if (!BUFFERP (buf)) continue;
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
969 b = XBUFFER (buf);
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
970
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
971 if (! PER_BUFFER_VALUE_P (b, idx))
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
972 PER_BUFFER_VALUE (b, offset) = newval;
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
973 }
3ca4a81861a1 (store_symval_forwarding): Handle setting default-fill-column, etc.,
Richard M. Stallman <rms@gnu.org>
parents: 53110
diff changeset
974 }
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
975 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
976
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
977 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
978 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
979 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
980 Lisp_Object type;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
981
50314
247bd25de9e9 (store_symval_forwarding): Re-instate part of the code
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50305
diff changeset
982 type = PER_BUFFER_TYPE (offset);
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
983 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
984 && XTYPE (newval) != XINT (type))
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
985 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
986
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
987 if (buf == NULL)
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
988 buf = current_buffer;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
989 PER_BUFFER_VALUE (buf, offset) = newval;
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
990 }
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
991 break;
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
992
11019
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
993 case Lisp_Misc_Kboard_Objfwd:
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
994 {
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
995 char *base = (char *) current_kboard;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
996 char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
997 *(Lisp_Object *) p = newval;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
998 }
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
999 break;
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
1000
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1001 default:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1002 goto def;
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1003 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1004 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1005
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1006 default:
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1007 def:
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1008 valcontents = SYMBOL_VALUE (symbol);
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1009 if (BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1010 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1011 XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1012 else
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1013 SET_SYMBOL_VALUE (symbol, newval);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1014 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1015 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1016
29618
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1017 /* Set up SYMBOL to refer to its global binding.
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1018 This makes it safe to alter the status of other bindings. */
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1019
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1020 void
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1021 swap_in_global_binding (symbol)
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1022 Lisp_Object symbol;
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1023 {
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1024 Lisp_Object valcontents, cdr;
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1025
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1026 valcontents = SYMBOL_VALUE (symbol);
29618
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1027 if (!BUFFER_LOCAL_VALUEP (valcontents)
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1028 && !SOME_BUFFER_LOCAL_VALUEP (valcontents))
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1029 abort ();
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1030 cdr = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1031
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1032 /* Unload the previously loaded binding. */
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1033 Fsetcdr (XCAR (cdr),
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1034 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1035
29618
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1036 /* Select the global binding in the symbol. */
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1037 XSETCAR (cdr, cdr);
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
1038 store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL);
29618
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1039
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1040 /* Indicate that the global binding is set up now. */
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1041 XBUFFER_LOCAL_VALUE (valcontents)->frame = Qnil;
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1042 XBUFFER_LOCAL_VALUE (valcontents)->buffer = Qnil;
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1043 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1044 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1045 }
e38bc8c4c7b3 (swap_in_global_binding): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 29237
diff changeset
1046
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1047 /* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1048 VALCONTENTS is the contents of its value cell,
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1049 which points to a struct Lisp_Buffer_Local_Value.
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1050
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1051 Return the value forwarded one step past the buffer-local stage.
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1052 This could be another forwarding pointer. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1053
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1054 static Lisp_Object
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1055 swap_in_symval_forwarding (symbol, valcontents)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1056 Lisp_Object symbol, valcontents;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1058 register Lisp_Object tem1;
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1059
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1060 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1061
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1062 if (NILP (tem1)
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1063 || current_buffer != XBUFFER (tem1)
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1064 || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1065 && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame)))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1066 {
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1067 if (XSYMBOL (symbol)->indirect_variable)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1068 symbol = indirect_variable (symbol);
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1069
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1070 /* Unload the previously loaded binding. */
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1071 tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1072 Fsetcdr (tem1,
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1073 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1074 /* Choose the new binding. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1075 tem1 = assq_no_quit (symbol, current_buffer->local_var_alist);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1076 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1077 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1078 if (NILP (tem1))
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1079 {
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1080 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
25665
8250026fe76d (swap_in_symval_forwarding): Change for Lisp_Object
Gerd Moellmann <gerd@gnu.org>
parents: 25504
diff changeset
1081 tem1 = assq_no_quit (symbol, XFRAME (selected_frame)->param_alist);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1082 if (! NILP (tem1))
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1083 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1084 else
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1085 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1086 }
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1087 else
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1088 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1089
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1090 /* Load the new binding. */
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1091 XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1092 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer);
25665
8250026fe76d (swap_in_symval_forwarding): Change for Lisp_Object
Gerd Moellmann <gerd@gnu.org>
parents: 25504
diff changeset
1093 XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1094 store_symval_forwarding (symbol,
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1095 XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
1096 Fcdr (tem1), NULL);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1097 }
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1098 return XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1099 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1100
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1101 /* 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
1102 This is helpful for code which just wants to get a variable's value
14036
621a575db6f7 Comment fixes.
Karl Heuer <kwzh@gnu.org>
parents: 13715
diff changeset
1103 if it has one, without signaling an error.
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1104 Note that it must not be possible to quit
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1105 within this function. Great care is required for this. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1106
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1107 Lisp_Object
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1108 find_symbol_value (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1109 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1110 {
25780
18cf58ed9400 (find_symbol_value): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents: 25665
diff changeset
1111 register Lisp_Object valcontents;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1112 register Lisp_Object val;
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1113
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1114 CHECK_SYMBOL (symbol);
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1115 valcontents = SYMBOL_VALUE (symbol);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1116
9889
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
1117 if (BUFFER_LOCAL_VALUEP (valcontents)
fd275e625abe Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 9878
diff changeset
1118 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
34964
f8c7b5b9fd2f (find_symbol_value): Remove extra 3rd argument in the
Eli Zaretskii <eliz@gnu.org>
parents: 31829
diff changeset
1119 valcontents = swap_in_symval_forwarding (symbol, valcontents);
9878
8a68b5794c91 (Fboundp, find_symbol_value): Use type test macros instead of checking XTYPE
Karl Heuer <kwzh@gnu.org>
parents: 9465
diff changeset
1120
8a68b5794c91 (Fboundp, find_symbol_value): Use type test macros instead of checking XTYPE
Karl Heuer <kwzh@gnu.org>
parents: 9465
diff changeset
1121 if (MISCP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1122 {
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
1123 switch (XMISCTYPE (valcontents))
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1124 {
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1125 case Lisp_Misc_Intfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1126 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
1127 return val;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1128
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1129 case Lisp_Misc_Boolfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1130 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1131
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1132 case Lisp_Misc_Objfwd:
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1133 return *XOBJFWD (valcontents)->objvar;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1134
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1135 case Lisp_Misc_Buffer_Objfwd:
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1136 return PER_BUFFER_VALUE (current_buffer,
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1137 XBUFFER_OBJFWD (valcontents)->offset);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
1138
11019
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
1139 case Lisp_Misc_Kboard_Objfwd:
48bf6677dab3 (find_symbol_value): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents: 11002
diff changeset
1140 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
1141 + (char *)current_kboard);
9465
ea2ee8bd3c63 (do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset,
Karl Heuer <kwzh@gnu.org>
parents: 9369
diff changeset
1142 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1143 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1144
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1145 return valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1146 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1147
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1148 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1149 doc: /* Return SYMBOL's value. Error if that is void. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1150 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1151 Lisp_Object symbol;
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1152 {
6497
89ff61b53cee (store_symval_forwarding, Fsymbol_value): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents: 6459
diff changeset
1153 Lisp_Object val;
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1154
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1155 val = find_symbol_value (symbol);
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1156 if (EQ (val, Qunbound))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1157 return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
514
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1158 else
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1159 return val;
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1160 }
626908d37dea *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 490
diff changeset
1161
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1162 DEFUN ("set", Fset, Sset, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1163 doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1164 (symbol, newval)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1165 register Lisp_Object symbol, newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1166 {
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1167 return set_internal (symbol, newval, current_buffer, 0);
16931
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1168 }
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1169
27703
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1170 /* Return 1 if SYMBOL currently has a let-binding
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1171 which was made in the buffer that is now current. */
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1172
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1173 static int
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1174 let_shadows_buffer_binding_p (symbol)
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1175 Lisp_Object symbol;
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1176 {
51030
7ef125284156 (let_shadows_buffer_binding_p): Make target of p volatile.
Richard M. Stallman <rms@gnu.org>
parents: 50632
diff changeset
1177 volatile struct specbinding *p;
27703
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1178
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1179 for (p = specpdl_ptr - 1; p >= specpdl; p--)
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1180 if (p->func == NULL
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1181 && CONSP (p->symbol))
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1182 {
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1183 Lisp_Object let_bound_symbol = XCAR (p->symbol);
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1184 if ((EQ (symbol, let_bound_symbol)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1185 || (XSYMBOL (let_bound_symbol)->indirect_variable
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1186 && EQ (symbol, indirect_variable (let_bound_symbol))))
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1187 && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1188 break;
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1189 }
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1190
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1191 return p >= specpdl;
27703
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1192 }
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1193
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
1194 /* Store the value NEWVAL into SYMBOL.
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1195 If buffer-locality is an issue, BUF specifies which buffer to use.
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1196 (0 stands for the current buffer.)
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1197
16931
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1198 If BINDFLAG is zero, then if this symbol is supposed to become
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1199 local in every buffer where it is set, then we make it local.
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1200 If BINDFLAG is nonzero, we don't do that. */
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1201
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1202 Lisp_Object
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1203 set_internal (symbol, newval, buf, bindflag)
16931
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1204 register Lisp_Object symbol, newval;
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1205 struct buffer *buf;
16931
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1206 int bindflag;
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1207 {
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
1208 int voide = EQ (newval, Qunbound);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1209
29735
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1210 register Lisp_Object valcontents, innercontents, tem1, current_alist_element;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1212 if (buf == 0)
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1213 buf = current_buffer;
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1214
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1215 /* If restoring in a dead buffer, do nothing. */
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1216 if (NILP (buf->name))
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1217 return newval;
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1218
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1219 CHECK_SYMBOL (symbol);
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1220 if (SYMBOL_CONSTANT_P (symbol)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1221 && (NILP (Fkeywordp (symbol))
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1222 || !EQ (newval, SYMBOL_VALUE (symbol))))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1223 return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
29735
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1224
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1225 innercontents = valcontents = SYMBOL_VALUE (symbol);
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1226
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1227 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1228 {
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1229 int offset = XBUFFER_OBJFWD (valcontents)->offset;
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1230 int idx = PER_BUFFER_IDX (offset);
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1231 if (idx > 0
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1232 && !bindflag
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1233 && !let_shadows_buffer_binding_p (symbol))
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1234 SET_PER_BUFFER_VALUE_P (buf, idx, 1);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1235 }
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1236 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
1237 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1238 {
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1239 /* valcontents is a struct Lisp_Buffer_Local_Value. */
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1240 if (XSYMBOL (symbol)->indirect_variable)
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1241 symbol = indirect_variable (symbol);
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1242
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1243 /* What binding is loaded right now? */
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1244 current_alist_element
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1245 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1246
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1247 /* If the current buffer is not the buffer whose binding is
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1248 loaded, or if there may be frame-local bindings and the frame
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1249 isn't the right one, or if it's a Lisp_Buffer_Local_Value and
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1250 the default binding is loaded, the loaded binding may be the
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1251 wrong one. */
28417
4b675266db04 * lisp.h (XCONS, XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XSUBR, XBUFFER):
Ken Raeburn <raeburn@raeburn.org>
parents: 28351
diff changeset
1252 if (!BUFFERP (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
4b675266db04 * lisp.h (XCONS, XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XSUBR, XBUFFER):
Ken Raeburn <raeburn@raeburn.org>
parents: 28351
diff changeset
1253 || buf != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1254 || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1255 && !EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1256 || (BUFFER_LOCAL_VALUEP (valcontents)
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1257 && EQ (XCAR (current_alist_element),
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1258 current_alist_element)))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1259 {
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1260 /* The currently loaded binding is not necessarily valid.
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1261 We need to unload it, and choose a new binding. */
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1262
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1263 /* Write out `realvalue' to the old loaded binding. */
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1264 Fsetcdr (current_alist_element,
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1265 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1266
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1267 /* Find the new binding. */
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1268 tem1 = Fassq (symbol, buf->local_var_alist);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1269 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1270 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1271
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1272 if (NILP (tem1))
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1273 {
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1274 /* This buffer still sees the default value. */
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1275
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1276 /* If the variable is a Lisp_Some_Buffer_Local_Value,
16931
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1277 or if this is `let' rather than `set',
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1278 make CURRENT-ALIST-ELEMENT point to itself,
27703
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1279 indicating that we're seeing the default value.
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1280 Likewise if the variable has been let-bound
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1281 in the current buffer. */
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1282 if (bindflag || SOME_BUFFER_LOCAL_VALUEP (valcontents)
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1283 || let_shadows_buffer_binding_p (symbol))
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1284 {
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1285 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1286
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1287 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
25665
8250026fe76d (swap_in_symval_forwarding): Change for Lisp_Object
Gerd Moellmann <gerd@gnu.org>
parents: 25504
diff changeset
1288 tem1 = Fassq (symbol,
8250026fe76d (swap_in_symval_forwarding): Change for Lisp_Object
Gerd Moellmann <gerd@gnu.org>
parents: 25504
diff changeset
1289 XFRAME (selected_frame)->param_alist);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1290
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1291 if (! NILP (tem1))
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1292 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1293 else
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1294 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1295 }
16931
8bdfc6767130 (set_internal): New subroutine. New arg BINDFLAG.
Richard M. Stallman <rms@gnu.org>
parents: 16787
diff changeset
1296 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
27703
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1297 and we're not within a let that was made for this buffer,
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1298 create a new buffer-local binding for the variable.
2ff09a66fbf1 (set_internal): Don't make variable buffer-local
Richard M. Stallman <rms@gnu.org>
parents: 27388
diff changeset
1299 That means, give this buffer a new assoc for a local value
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1300 and load that binding. */
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1301 else
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1302 {
46279
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
1303 tem1 = Fcons (symbol, XCDR (current_alist_element));
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1304 buf->local_var_alist
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1305 = Fcons (tem1, buf->local_var_alist);
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1306 }
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1307 }
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1308
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1309 /* Record which binding is now loaded. */
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1310 XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr,
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1311 tem1);
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1312
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1313 /* Set `buffer' and `frame' slots for thebinding now loaded. */
27294
b62412c9ab2a (set_internal): New arg BUF.
Richard M. Stallman <rms@gnu.org>
parents: 26931
diff changeset
1314 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, buf);
25665
8250026fe76d (swap_in_symval_forwarding): Change for Lisp_Object
Gerd Moellmann <gerd@gnu.org>
parents: 25504
diff changeset
1315 XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1316 }
29735
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1317 innercontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1318 }
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1319
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1320 /* If storing void (making the symbol void), forward only through
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1321 buffer-local indicator, not through Lisp_Objfwd, etc. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1322 if (voide)
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
1323 store_symval_forwarding (symbol, Qnil, newval, buf);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324 else
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
1325 store_symval_forwarding (symbol, innercontents, newval, buf);
29735
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1326
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1327 /* If we just set a variable whose current binding is frame-local,
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1328 store the new value in the frame parameter too. */
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1329
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1330 if (BUFFER_LOCAL_VALUEP (valcontents)
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1331 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1332 {
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1333 /* What binding is loaded right now? */
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1334 current_alist_element
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1335 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1336
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1337 /* If the current buffer is not the buffer whose binding is
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1338 loaded, or if there may be frame-local bindings and the frame
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1339 isn't the right one, or if it's a Lisp_Buffer_Local_Value and
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1340 the default binding is loaded, the loaded binding may be the
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1341 wrong one. */
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1342 if (XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1343 XSETCDR (current_alist_element, newval);
29735
ab56f683df46 (set_internal): If variable is frame-local,
Gerd Moellmann <gerd@gnu.org>
parents: 29660
diff changeset
1344 }
733
62dd28940dc6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 695
diff changeset
1345
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1346 return newval;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1347 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1348
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1349 /* Access or set a buffer-local symbol's default value. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1350
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1351 /* Return the default value of SYMBOL, but don't check for voidness.
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
1352 Return Qunbound if it is void. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1353
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1354 Lisp_Object
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1355 default_value (symbol)
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1356 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1357 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358 register Lisp_Object valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1359
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1360 CHECK_SYMBOL (symbol);
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1361 valcontents = SYMBOL_VALUE (symbol);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1362
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1363 /* For a built-in buffer-local variable, get the default value
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1364 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
1365 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1366 {
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1367 int offset = XBUFFER_OBJFWD (valcontents)->offset;
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1368 if (PER_BUFFER_IDX (offset) != 0)
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1369 return PER_BUFFER_DEFAULT (offset);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1370 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1371
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1372 /* 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
1373 if (BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1374 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1375 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1376 /* 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
1377 the current value is nominally the default value.
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1378 But the `realvalue' slot may be more up to date, since
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1379 ordinary setq stores just that slot. So use that. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1380 Lisp_Object current_alist_element, alist_element_car;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1381 current_alist_element
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1382 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1383 alist_element_car = XCAR (current_alist_element);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1384 if (EQ (alist_element_car, current_alist_element))
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1385 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1386 else
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1387 return XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1388 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1389 /* For other variables, get the current value. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1390 return do_symval_forwarding (valcontents);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1391 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1392
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1393 DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1394 doc: /* Return t if SYMBOL has a non-void default value.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1395 This is the value that is seen in buffers that do not have their own values
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1396 for this variable. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1397 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1398 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1399 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1400 register Lisp_Object value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1401
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1402 value = default_value (symbol);
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
1403 return (EQ (value, Qunbound) ? Qnil : Qt);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1404 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1405
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1406 DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1407 doc: /* Return SYMBOL's default value.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1408 This is the value that is seen in buffers that do not have their own values
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1409 for this variable. The default value is meaningful for variables with
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1410 local bindings in certain buffers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1411 (symbol)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1412 Lisp_Object symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1413 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1414 register Lisp_Object value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1415
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1416 value = default_value (symbol);
9369
379c7b900689 (Fboundp, Ffboundp, find_symbol_value, Fset, Fdefault_boundp, Fdefault_value):
Karl Heuer <kwzh@gnu.org>
parents: 9366
diff changeset
1417 if (EQ (value, Qunbound))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1418 return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1419 return value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1420 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
55616
c2be5da8c8cb (Fset_default): Make argument names match their use in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55455
diff changeset
1423 doc: /* Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1424 The default value is seen in buffers that do not have their own values
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1425 for this variable. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1426 (symbol, value)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1427 Lisp_Object symbol, value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1428 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1429 register Lisp_Object valcontents, current_alist_element, alist_element_buffer;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1431 CHECK_SYMBOL (symbol);
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1432 valcontents = SYMBOL_VALUE (symbol);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1433
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1434 /* Handle variables like case-fold-search that have special slots
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1435 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1436 variables. */
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1437 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1438 {
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1439 int offset = XBUFFER_OBJFWD (valcontents)->offset;
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1440 int idx = PER_BUFFER_IDX (offset);
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1441
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1442 PER_BUFFER_DEFAULT (offset) = value;
20996
b52e351a40fa (store_symval_forwarding) <Lisp_Misc_Buffer_Objfwd>:
Karl Heuer <kwzh@gnu.org>
parents: 20827
diff changeset
1443
b52e351a40fa (store_symval_forwarding) <Lisp_Misc_Buffer_Objfwd>:
Karl Heuer <kwzh@gnu.org>
parents: 20827
diff changeset
1444 /* If this variable is not always local in all buffers,
b52e351a40fa (store_symval_forwarding) <Lisp_Misc_Buffer_Objfwd>:
Karl Heuer <kwzh@gnu.org>
parents: 20827
diff changeset
1445 set it in the buffers that don't nominally have a local value. */
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1446 if (idx > 0)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1447 {
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1448 struct buffer *b;
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1449
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1450 for (b = all_buffers; b; b = b->next)
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1451 if (!PER_BUFFER_VALUE_P (b, idx))
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1452 PER_BUFFER_VALUE (b, offset) = value;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1453 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1454 return value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1455 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1456
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1457 if (!BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1458 && !SOME_BUFFER_LOCAL_VALUEP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1459 return Fset (symbol, value);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1460
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1461 /* Store new value into the DEFAULT-VALUE slot. */
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1462 XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1463
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1464 /* If the default binding is now loaded, set the REALVALUE slot too. */
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1465 current_alist_element
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1466 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467 alist_element_buffer = Fcar (current_alist_element);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1468 if (EQ (alist_element_buffer, current_alist_element))
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
1469 store_symval_forwarding (symbol,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
1470 XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
1471 value, NULL);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1472
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1473 return value;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1474 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1475
60064
896e880eab56 (Fsetq_default): Allow no arg case.
Richard M. Stallman <rms@gnu.org>
parents: 59110
diff changeset
1476 DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1477 doc: /* Set the default value of variable VAR to VALUE.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1478 VAR, the variable name, is literal (not evaluated);
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1479 VALUE is an expression: it is evaluated and its value returned.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1480 The default value of a variable is seen in buffers
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1481 that do not have their own values for the variable.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1482
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1483 More generally, you can use multiple variables and values, as in
55378
f406ef28e71a (Fsetq_default): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55230
diff changeset
1484 (setq-default VAR VALUE VAR VALUE...)
f406ef28e71a (Fsetq_default): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55230
diff changeset
1485 This sets each VAR's default value to the corresponding VALUE.
f406ef28e71a (Fsetq_default): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55230
diff changeset
1486 The VALUE for the Nth VAR can refer to the new default values
f406ef28e71a (Fsetq_default): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55230
diff changeset
1487 of previous VARs.
60064
896e880eab56 (Fsetq_default): Allow no arg case.
Richard M. Stallman <rms@gnu.org>
parents: 59110
diff changeset
1488 usage: (setq-default [VAR VALUE...]) */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1489 (args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1490 Lisp_Object args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1491 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1492 register Lisp_Object args_left;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1493 register Lisp_Object val, symbol;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1494 struct gcpro gcpro1;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1495
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1496 if (NILP (args))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1497 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1498
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1499 args_left = args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1500 GCPRO1 (args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1501
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1502 do
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1503 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1504 val = Feval (Fcar (Fcdr (args_left)));
46279
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
1505 symbol = XCAR (args_left);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1506 Fset_default (symbol, val);
46279
5f4ed17e4396 (Fdefalias): Add an optional `docstring' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45397
diff changeset
1507 args_left = Fcdr (XCDR (args_left));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1508 }
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1509 while (!NILP (args_left));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1510
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1511 UNGCPRO;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1512 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1513 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1514
1278
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1515 /* 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
1516
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1517 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1518 1, 1, "vMake Variable Buffer Local: ",
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1519 doc: /* Make VARIABLE become buffer-local whenever it is set.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1520 At any time, the value for the current buffer is in effect,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1521 unless the variable has never been set in this buffer,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1522 in which case the default value is in effect.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1523 Note that binding the variable with `let', or setting it while
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1524 a `let'-style binding made in this buffer is in effect,
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1525 does not make the variable buffer-local. Return VARIABLE.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1526
58733
947c0bab2dd9 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 58086
diff changeset
1527 In most cases it is better to use `make-local-variable',
947c0bab2dd9 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 58086
diff changeset
1528 which makes a variable local in just one buffer.
947c0bab2dd9 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 58086
diff changeset
1529
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1530 The function `default-value' gets the default value and `set-default' sets it. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1531 (variable)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1532 register Lisp_Object variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1533 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1534 register Lisp_Object tem, valcontents, newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1535
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1536 CHECK_SYMBOL (variable);
52376
78af369bc6ac (Fmake_variable_buffer_local, Fmake_local_variable)
Richard M. Stallman <rms@gnu.org>
parents: 51030
diff changeset
1537 variable = indirect_variable (variable);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1538
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1539 valcontents = SYMBOL_VALUE (variable);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1540 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
1541 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1542
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1543 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1544 return variable;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1545 if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1546 {
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1547 XMISCTYPE (SYMBOL_VALUE (variable)) = Lisp_Misc_Buffer_Local_Value;
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1548 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1550 if (EQ (valcontents, Qunbound))
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1551 SET_SYMBOL_VALUE (variable, Qnil);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1552 tem = Fcons (Qnil, Fsymbol_value (variable));
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1553 XSETCAR (tem, tem);
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1554 newval = allocate_misc ();
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
1555 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1556 XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1557 XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer ();
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1558 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1559 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1560 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1561 XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1562 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1563 SET_SYMBOL_VALUE (variable, newval);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1564 return variable;
298
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 ("make-local-variable", Fmake_local_variable, Smake_local_variable,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1568 1, 1, "vMake Local Variable: ",
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1569 doc: /* Make VARIABLE have a separate value in the current buffer.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1570 Other buffers will continue to share a common default value.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1571 \(The buffer-local value of VARIABLE starts out as the same value
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1572 VARIABLE previously had. If VARIABLE was void, it remains void.\)
58733
947c0bab2dd9 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 58086
diff changeset
1573 Return VARIABLE.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1574
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1575 If the variable is already arranged to become local when set,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1576 this function causes a local value to exist for this buffer,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1577 just as setting the variable would do.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1578
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1579 This function returns VARIABLE, and therefore
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1580 (set (make-local-variable 'VARIABLE) VALUE-EXP)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1581 works.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1582
58733
947c0bab2dd9 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 58086
diff changeset
1583 See also `make-variable-buffer-local'.
947c0bab2dd9 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 58086
diff changeset
1584
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1585 Do not use `make-local-variable' to make a hook variable buffer-local.
40628
ae231ad6710d (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 40123
diff changeset
1586 Instead, use `add-hook' and specify t for the LOCAL argument. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1587 (variable)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1588 register Lisp_Object variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1589 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1590 register Lisp_Object tem, valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1591
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1592 CHECK_SYMBOL (variable);
52376
78af369bc6ac (Fmake_variable_buffer_local, Fmake_local_variable)
Richard M. Stallman <rms@gnu.org>
parents: 51030
diff changeset
1593 variable = indirect_variable (variable);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1594
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1595 valcontents = SYMBOL_VALUE (variable);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1596 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
1597 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1598
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1599 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1600 {
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1601 tem = Fboundp (variable);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
1602
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1603 /* Make sure the symbol has a local value in this particular buffer,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1604 by setting it to the same value it already has. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1605 Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound));
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1606 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1607 }
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1608 /* Make sure symbol is set up to hold per-buffer values. */
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1609 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1610 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1611 Lisp_Object newval;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1612 tem = Fcons (Qnil, do_symval_forwarding (valcontents));
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1613 XSETCAR (tem, tem);
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1614 newval = allocate_misc ();
11239
38aef18e8e3d (Ftype_of, do_symval_forwarding, store_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 11219
diff changeset
1615 XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1616 XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1617 XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1618 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1619 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1620 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1621 XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1622 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1623 SET_SYMBOL_VALUE (variable, newval);;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1624 }
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1625 /* Make sure this buffer has its own value of symbol. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1626 tem = Fassq (variable, current_buffer->local_var_alist);
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1627 if (NILP (tem))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1628 {
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1629 /* Swap out any local binding for some other buffer, and make
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1630 sure the current value is permanently recorded, if it's the
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1631 default value. */
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1632 find_symbol_value (variable);
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1633
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634 current_buffer->local_var_alist
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1635 = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->cdr)),
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1636 current_buffer->local_var_alist);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1637
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1638 /* Make sure symbol does not think it is set up for this buffer;
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1639 force it to look once again for this buffer's value. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1640 {
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1641 Lisp_Object *pvalbuf;
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1642
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1643 valcontents = SYMBOL_VALUE (variable);
13593
e27c32c7d428 (Fmake_local_variable): Call find_symbol_value
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
1644
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1645 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1646 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
1647 *pvalbuf = Qnil;
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1648 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1649 }
1278
0a0646ae381f * data.c (Fmake_local_variable): If SYM forwards to a C variable,
Jim Blandy <jimb@redhat.com>
parents: 1263
diff changeset
1650 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1651
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1652 /* If the symbol forwards into a C variable, then load the binding
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1653 for this buffer now. If C code modifies the variable before we
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1654 load the binding in, then that new value will clobber the default
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1655 binding the next time we unload it. */
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1656 valcontents = XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->realvalue;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1657 if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents))
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1658 swap_in_symval_forwarding (variable, SYMBOL_VALUE (variable));
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1659
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1660 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1661 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1662
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1663 DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1664 1, 1, "vKill Local Variable: ",
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1665 doc: /* Make VARIABLE no longer have a separate value in the current buffer.
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
1666 From now on the default value will apply in this buffer. Return VARIABLE. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1667 (variable)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1668 register Lisp_Object variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1669 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1670 register Lisp_Object tem, valcontents;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1671
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1672 CHECK_SYMBOL (variable);
52376
78af369bc6ac (Fmake_variable_buffer_local, Fmake_local_variable)
Richard M. Stallman <rms@gnu.org>
parents: 51030
diff changeset
1673 variable = indirect_variable (variable);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1674
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1675 valcontents = SYMBOL_VALUE (variable);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1676
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1677 if (BUFFER_OBJFWDP (valcontents))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1678 {
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1679 int offset = XBUFFER_OBJFWD (valcontents)->offset;
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1680 int idx = PER_BUFFER_IDX (offset);
28312
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1681
034f252dd69b (do_symval_forwarding, store_symval_forwarding)
Gerd Moellmann <gerd@gnu.org>
parents: 27826
diff changeset
1682 if (idx > 0)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1683 {
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1684 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1685 PER_BUFFER_VALUE (current_buffer, offset)
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1686 = PER_BUFFER_DEFAULT (offset);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1687 }
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1688 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1689 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1691 if (!BUFFER_LOCAL_VALUEP (valcontents)
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1692 && !SOME_BUFFER_LOCAL_VALUEP (valcontents))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1693 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1694
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1695 /* Get rid of this buffer's alist element, if any. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1696
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1697 tem = Fassq (variable, current_buffer->local_var_alist);
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
1698 if (!NILP (tem))
9895
924f7b9ce544 (store_symval_forwarding, swap_in_symval_forwarding, Fset, default_value,
Karl Heuer <kwzh@gnu.org>
parents: 9889
diff changeset
1699 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
1700 = Fdelq (tem, current_buffer->local_var_alist);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1701
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1702 /* If the symbol is set up with the current buffer's binding
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1703 loaded, recompute its value. We have to do it now, or else
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1704 forwarded objects won't work right. */
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1705 {
50305
77bee06b14c5 (store_symval_forwarding): Delete special read-only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50109
diff changeset
1706 Lisp_Object *pvalbuf, buf;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1707 valcontents = SYMBOL_VALUE (variable);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1708 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
50305
77bee06b14c5 (store_symval_forwarding): Delete special read-only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50109
diff changeset
1709 XSETBUFFER (buf, current_buffer);
77bee06b14c5 (store_symval_forwarding): Delete special read-only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50109
diff changeset
1710 if (EQ (buf, *pvalbuf))
14264
215d8ba39537 (kill-local-variable): didn't update the value of
Karl Heuer <kwzh@gnu.org>
parents: 14186
diff changeset
1711 {
215d8ba39537 (kill-local-variable): didn't update the value of
Karl Heuer <kwzh@gnu.org>
parents: 14186
diff changeset
1712 *pvalbuf = Qnil;
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1713 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
14745
f78162b0fc6e (Fkill_local_variable): Call find_symbol_value directly,
Richard M. Stallman <rms@gnu.org>
parents: 14302
diff changeset
1714 find_symbol_value (variable);
14264
215d8ba39537 (kill-local-variable): didn't update the value of
Karl Heuer <kwzh@gnu.org>
parents: 14186
diff changeset
1715 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1716 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1717
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1718 return variable;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719 }
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1720
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1721 /* Lisp functions for creating and removing buffer-local variables. */
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1722
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1723 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1724 1, 1, "vMake Variable Frame Local: ",
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1725 doc: /* Enable VARIABLE to have frame-local bindings.
66542
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1726 This does not create any frame-local bindings for VARIABLE,
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1727 it just makes them possible.
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1728
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1729 A frame-local binding is actually a frame parameter value.
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1730 If a frame F has a value for the frame parameter named VARIABLE,
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1731 that also acts as a frame-local binding for VARIABLE in F--
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1732 provided this function has been called to enable VARIABLE
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1733 to have frame-local bindings at all.
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1734
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1735 The only way to create a frame-local binding for VARIABLE in a frame
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1736 is to set the VARIABLE frame parameter of that frame. See
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1737 `modify-frame-parameters' for how to set frame parameters.
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1738
33b15a14f9b3 (Fmake_variable_frame_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 66475
diff changeset
1739 Buffer-local bindings take precedence over frame-local bindings. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1740 (variable)
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1741 register Lisp_Object variable;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1742 {
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1743 register Lisp_Object tem, valcontents, newval;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1744
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1745 CHECK_SYMBOL (variable);
52376
78af369bc6ac (Fmake_variable_buffer_local, Fmake_local_variable)
Richard M. Stallman <rms@gnu.org>
parents: 51030
diff changeset
1746 variable = indirect_variable (variable);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1747
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1748 valcontents = SYMBOL_VALUE (variable);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1749 if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1750 || BUFFER_OBJFWDP (valcontents))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
1751 error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1752
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1753 if (BUFFER_LOCAL_VALUEP (valcontents)
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1754 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
27778
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1755 {
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1756 XBUFFER_LOCAL_VALUE (valcontents)->check_frame = 1;
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1757 return variable;
f100dbd7e3a0 (Fmake_variable_buffer_local): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 27758
diff changeset
1758 }
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1759
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1760 if (EQ (valcontents, Qunbound))
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1761 SET_SYMBOL_VALUE (variable, Qnil);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1762 tem = Fcons (Qnil, Fsymbol_value (variable));
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39775
diff changeset
1763 XSETCAR (tem, tem);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1764 newval = allocate_misc ();
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1765 XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1766 XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1767 XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1768 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1769 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1770 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1771 XBUFFER_LOCAL_VALUE (newval)->check_frame = 1;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1772 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1773 SET_SYMBOL_VALUE (variable, newval);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1774 return variable;
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1775 }
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
1776
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1777 DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1778 1, 2, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1779 doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1780 BUFFER defaults to the current buffer. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1781 (variable, buffer)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1782 register Lisp_Object variable, buffer;
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1783 {
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1784 Lisp_Object valcontents;
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1785 register struct buffer *buf;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1786
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1787 if (NILP (buffer))
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1788 buf = current_buffer;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1789 else
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1790 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1791 CHECK_BUFFER (buffer);
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1792 buf = XBUFFER (buffer);
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1793 }
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1794
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1795 CHECK_SYMBOL (variable);
52376
78af369bc6ac (Fmake_variable_buffer_local, Fmake_local_variable)
Richard M. Stallman <rms@gnu.org>
parents: 51030
diff changeset
1796 variable = indirect_variable (variable);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1797
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1798 valcontents = SYMBOL_VALUE (variable);
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1799 if (BUFFER_LOCAL_VALUEP (valcontents)
12225
a0067d2edef7 (Flocal_variable_p): Fix backwards logical operator.
Richard M. Stallman <rms@gnu.org>
parents: 12113
diff changeset
1800 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1801 {
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1802 Lisp_Object tail, elt;
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1803
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1804 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1805 {
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1806 elt = XCAR (tail);
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1807 if (EQ (variable, XCAR (elt)))
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1808 return Qt;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1809 }
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1810 }
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1811 if (BUFFER_OBJFWDP (valcontents))
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1812 {
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1813 int offset = XBUFFER_OBJFWD (valcontents)->offset;
28351
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1814 int idx = PER_BUFFER_IDX (offset);
e3d57f7fba49 Use new macro names
Gerd Moellmann <gerd@gnu.org>
parents: 28312
diff changeset
1815 if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
12113
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1816 return Qt;
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1817 }
d96b45f31afa (Flocal_variable_p): New optional arg BUFFER.
Karl Heuer <kwzh@gnu.org>
parents: 12043
diff changeset
1818 return Qnil;
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1819 }
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1820
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1821 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1822 1, 2, 0,
57618
1eb191c19f7f (Flocal_variable_if_set_p): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56590
diff changeset
1823 doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there.
1eb191c19f7f (Flocal_variable_if_set_p): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56590
diff changeset
1824 More precisely, this means that setting the variable \(with `set' or`setq'),
1eb191c19f7f (Flocal_variable_if_set_p): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56590
diff changeset
1825 while it does not have a `let'-style binding that was made in BUFFER,
1eb191c19f7f (Flocal_variable_if_set_p): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56590
diff changeset
1826 will produce a buffer local binding. See Info node
1eb191c19f7f (Flocal_variable_if_set_p): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56590
diff changeset
1827 `(elisp)Creating Buffer-Local'.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1828 BUFFER defaults to the current buffer. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1829 (variable, buffer)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1830 register Lisp_Object variable, buffer;
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1831 {
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1832 Lisp_Object valcontents;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1833 register struct buffer *buf;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1834
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1835 if (NILP (buffer))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1836 buf = current_buffer;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1837 else
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1838 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1839 CHECK_BUFFER (buffer);
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1840 buf = XBUFFER (buffer);
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1841 }
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1842
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1843 CHECK_SYMBOL (variable);
52376
78af369bc6ac (Fmake_variable_buffer_local, Fmake_local_variable)
Richard M. Stallman <rms@gnu.org>
parents: 51030
diff changeset
1844 variable = indirect_variable (variable);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
1845
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
1846 valcontents = SYMBOL_VALUE (variable);
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1847
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1848 /* This means that make-variable-buffer-local was done. */
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1849 if (BUFFER_LOCAL_VALUEP (valcontents))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1850 return Qt;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1851 /* All these slots become local if they are set. */
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1852 if (BUFFER_OBJFWDP (valcontents))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1853 return Qt;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1854 if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1855 {
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1856 Lisp_Object tail, elt;
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1857 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1858 {
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1859 elt = XCAR (tail);
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
1860 if (EQ (variable, XCAR (elt)))
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1861 return Qt;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1862 }
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1863 }
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1864 return Qnil;
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
1865 }
52537
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1866
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1867 DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus,
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1868 1, 1, 0,
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1869 doc: /* Return a value indicating where VARIABLE's current binding comes from.
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1870 If the current binding is buffer-local, the value is the current buffer.
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1871 If the current binding is frame-local, the value is the selected frame.
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1872 If the current binding is global (the default), the value is nil. */)
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1873 (variable)
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1874 register Lisp_Object variable;
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1875 {
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1876 Lisp_Object valcontents;
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1877
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1878 CHECK_SYMBOL (variable);
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1879 variable = indirect_variable (variable);
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1880
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1881 /* Make sure the current binding is actually swapped in. */
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1882 find_symbol_value (variable);
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1883
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1884 valcontents = XSYMBOL (variable)->value;
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1885
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1886 if (BUFFER_LOCAL_VALUEP (valcontents)
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1887 || SOME_BUFFER_LOCAL_VALUEP (valcontents)
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1888 || BUFFER_OBJFWDP (valcontents))
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1889 {
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1890 /* For a local variable, record both the symbol and which
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1891 buffer's or frame's value we are saving. */
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1892 if (!NILP (Flocal_variable_p (variable, Qnil)))
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1893 return Fcurrent_buffer ();
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1894 else if (!BUFFER_OBJFWDP (valcontents)
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1895 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1896 return XBUFFER_LOCAL_VALUE (valcontents)->frame;
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1897 }
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1898
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1899 return Qnil;
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
1900 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1901
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1902 /* 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
1903
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1904 /* 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
1905 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
1906 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
1907 cyclic-function-indirection error.
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1908
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1909 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
1910 error if the chain ends up unbound. */
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1911 Lisp_Object
1648
27e9f99fe095 src/ * data.c (indirect_function): Delete unused argument ERROR.
Jim Blandy <jimb@redhat.com>
parents: 1508
diff changeset
1912 indirect_function (object)
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
1913 register Lisp_Object object;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1914 {
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1915 Lisp_Object tortoise, hare;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1916
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1917 hare = tortoise = object;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1918
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1919 for (;;)
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1920 {
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1921 if (!SYMBOLP (hare) || EQ (hare, Qunbound))
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1922 break;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1923 hare = XSYMBOL (hare)->function;
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1924 if (!SYMBOLP (hare) || EQ (hare, Qunbound))
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1925 break;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1926 hare = XSYMBOL (hare)->function;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1927
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1928 tortoise = XSYMBOL (tortoise)->function;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1929
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3529
diff changeset
1930 if (EQ (hare, tortoise))
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1931 Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil));
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1932 }
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1933
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1934 return hare;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1935 }
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1936
68758
13c1b7c5f555 * data.c (Findirect_function): Add NOERROR arg. All callers changed
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
1937 DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1938 doc: /* Return the function at the end of OBJECT's function chain.
68780
eb6c6d7a4c7f (Findirect_function): Rewrite docstring.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68758
diff changeset
1939 If OBJECT is not a symbol, just return it. Otherwise, follow all
eb6c6d7a4c7f (Findirect_function): Rewrite docstring.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68758
diff changeset
1940 function indirections to find the final function binding and return it.
eb6c6d7a4c7f (Findirect_function): Rewrite docstring.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68758
diff changeset
1941 If the final symbol in the chain is unbound, signal a void-function error.
eb6c6d7a4c7f (Findirect_function): Rewrite docstring.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68758
diff changeset
1942 Optional arg NOERROR non-nil means to return nil instead of signalling.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1943 Signal a cyclic-function-indirection error if there is a loop in the
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1944 function chain of symbols. */)
68780
eb6c6d7a4c7f (Findirect_function): Rewrite docstring.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68758
diff changeset
1945 (object, noerror)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1946 register Lisp_Object object;
68780
eb6c6d7a4c7f (Findirect_function): Rewrite docstring.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68758
diff changeset
1947 Lisp_Object noerror;
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1948 {
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1949 Lisp_Object result;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1950
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1951 result = indirect_function (object);
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1952
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1953 if (EQ (result, Qunbound))
68758
13c1b7c5f555 * data.c (Findirect_function): Add NOERROR arg. All callers changed
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
1954 return (NILP (noerror)
13c1b7c5f555 * data.c (Findirect_function): Add NOERROR arg. All callers changed
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
1955 ? Fsignal (Qvoid_function, Fcons (object, Qnil))
13c1b7c5f555 * data.c (Findirect_function): Add NOERROR arg. All callers changed
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
1956 : Qnil);
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1957 return result;
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1958 }
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
1959
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1960 /* Extract and set vector and string elements */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1961
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1962 DEFUN ("aref", Faref, Saref, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1963 doc: /* Return the element of ARRAY at index IDX.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1964 ARRAY may be a vector, a string, a char-table, a bool-vector,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1965 or a byte-code object. IDX starts at 0. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
1966 (array, idx)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1967 register Lisp_Object array;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1968 Lisp_Object idx;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1969 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1970 register int idxval;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1971
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
1972 CHECK_NUMBER (idx);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1973 idxval = XINT (idx);
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
1974 if (STRINGP (array))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 {
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
1976 int c, idxval_byte;
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
1977
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
1978 if (idxval < 0 || idxval >= SCHARS (array))
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
1979 args_out_of_range (array, idx);
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
1980 if (! STRING_MULTIBYTE (array))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
1981 return make_number ((unsigned char) SREF (array, idxval));
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
1982 idxval_byte = string_char_to_byte (array, idxval);
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
1983
46422
50a2414d96b7 * data.c (Faref): Use SDATA.
Ken Raeburn <raeburn@raeburn.org>
parents: 46370
diff changeset
1984 c = STRING_CHAR (SDATA (array) + idxval_byte,
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
1985 SBYTES (array) - idxval_byte);
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
1986 return make_number (c);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1987 }
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1988 else if (BOOL_VECTOR_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1989 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1990 int val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1991
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1992 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1993 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1994
55160
5b975496f8d9 (Faref, Faset): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 54660
diff changeset
1995 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];
5b975496f8d9 (Faref, Faset): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 54660
diff changeset
1996 return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1997 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1998 else if (CHAR_TABLE_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
1999 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2000 Lisp_Object val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2001
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 30356
diff changeset
2002 val = Qnil;
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 30356
diff changeset
2003
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2004 if (idxval < 0)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2005 args_out_of_range (array, idx);
20827
4b85e02aae14 (Faref, Faset): Allow indexing a char-table
Richard M. Stallman <rms@gnu.org>
parents: 20793
diff changeset
2006 if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2007 {
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2008 if (! SINGLE_BYTE_CHAR_P (idxval))
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2009 args_out_of_range (array, idx);
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2010 /* For ASCII and 8-bit European characters, the element is
17184
caab9110ee07 (Faref, Faset): Adjusted for the change of CHAR_TABLE_ORDINARY_SLOTS.
Kenichi Handa <handa@m17n.org>
parents: 17117
diff changeset
2011 stored in the top table. */
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2012 val = XCHAR_TABLE (array)->contents[idxval];
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2013 if (NILP (val))
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2014 {
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2015 int default_slot
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2016 = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2017 : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2018 : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC);
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2019 val = XCHAR_TABLE (array)->contents[default_slot];
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2020 }
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2021 if (NILP (val))
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2022 val = XCHAR_TABLE (array)->defalt;
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2023 while (NILP (val)) /* Follow parents until we find some value. */
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2024 {
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2025 array = XCHAR_TABLE (array)->parent;
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2026 if (NILP (array))
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2027 return Qnil;
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2028 val = XCHAR_TABLE (array)->contents[idxval];
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2029 if (NILP (val))
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2030 val = XCHAR_TABLE (array)->defalt;
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2031 }
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2032 return val;
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2033 }
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2034 else
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2035 {
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2036 int code[4], i;
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2037 Lisp_Object sub_table;
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2038 Lisp_Object current_default;
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2039
29007
180a8014aa14 (Faref): Use SPLIT_CHAR instead of SPLIT_NON_ASCII_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 28417
diff changeset
2040 SPLIT_CHAR (idxval, code[0], code[1], code[2]);
26849
a0ecda172035 (Faref): Delete codes for a composite character..
Kenichi Handa <handa@m17n.org>
parents: 26274
diff changeset
2041 if (code[1] < 32) code[1] = -1;
a0ecda172035 (Faref): Delete codes for a composite character..
Kenichi Handa <handa@m17n.org>
parents: 26274
diff changeset
2042 else if (code[2] < 32) code[2] = -1;
a0ecda172035 (Faref): Delete codes for a composite character..
Kenichi Handa <handa@m17n.org>
parents: 26274
diff changeset
2043
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2044 /* Here, the possible range of CODE[0] (== charset ID) is
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2045 128..MAX_CHARSET. Since the top level char table contains
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2046 data for multibyte characters after 256th element, we must
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2047 increment CODE[0] by 128 to get a correct index. */
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2048 code[0] += 128;
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2049 code[3] = -1; /* anchor */
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2050
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2051 try_parent_char_table:
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2052 current_default = XCHAR_TABLE (array)->defalt;
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2053 sub_table = array;
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2054 for (i = 0; code[i] >= 0; i++)
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2055 {
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2056 val = XCHAR_TABLE (sub_table)->contents[code[i]];
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2057 if (SUB_CHAR_TABLE_P (val))
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2058 {
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2059 sub_table = val;
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2060 if (! NILP (XCHAR_TABLE (sub_table)->defalt))
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2061 current_default = XCHAR_TABLE (sub_table)->defalt;
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2062 }
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2063 else
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2064 {
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2065 if (NILP (val))
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2066 val = current_default;
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2067 if (NILP (val))
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2068 {
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2069 array = XCHAR_TABLE (array)->parent;
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2070 if (!NILP (array))
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2071 goto try_parent_char_table;
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2072 }
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2073 return val;
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2074 }
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2075 }
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2076 /* Reaching here means IDXVAL is a generic character in
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2077 which each character or a group has independent value.
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2078 Essentially it's nonsense to get a value for such a
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2079 generic character, but for backward compatibility, we try
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2080 the default value and parent. */
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2081 val = current_default;
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2082 if (NILP (val))
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2083 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2084 array = XCHAR_TABLE (array)->parent;
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2085 if (!NILP (array))
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2086 goto try_parent_char_table;
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2087 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2088 return val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2089 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2090 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2091 else
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2092 {
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 30356
diff changeset
2093 int size = 0;
10290
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2094 if (VECTORP (array))
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2095 size = XVECTOR (array)->size;
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2096 else if (COMPILEDP (array))
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2097 size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2098 else
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2099 wrong_type_argument (Qarrayp, array);
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2100
1bcc91a4b210 (Faref): Handle compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents: 10248
diff changeset
2101 if (idxval < 0 || idxval >= size)
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2102 args_out_of_range (array, idx);
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2103 return XVECTOR (array)->contents[idxval];
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2104 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2105 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2106
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2107 DEFUN ("aset", Faset, Saset, 3, 3, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2108 doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
2109 Return NEWELT. ARRAY may be a vector, a string, a char-table or a
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
2110 bool-vector. IDX starts at 0. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2111 (array, idx, newelt)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2112 register Lisp_Object array;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2113 Lisp_Object idx, newelt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2114 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2115 register int idxval;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2116
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2117 CHECK_NUMBER (idx);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2118 idxval = XINT (idx);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2119 if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2120 && ! CHAR_TABLE_P (array))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2121 array = wrong_type_argument (Qarrayp, array);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2122 CHECK_IMPURE (array);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2123
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
2124 if (VECTORP (array))
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2125 {
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2126 if (idxval < 0 || idxval >= XVECTOR (array)->size)
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2127 args_out_of_range (array, idx);
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2128 XVECTOR (array)->contents[idxval] = newelt;
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2129 }
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2130 else if (BOOL_VECTOR_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2131 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2132 int val;
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2133
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2134 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2135 args_out_of_range (array, idx);
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2136
55160
5b975496f8d9 (Faref, Faset): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 54660
diff changeset
2137 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2138
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2139 if (! NILP (newelt))
55160
5b975496f8d9 (Faref, Faset): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 54660
diff changeset
2140 val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2141 else
55160
5b975496f8d9 (Faref, Faset): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 54660
diff changeset
2142 val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR));
5b975496f8d9 (Faref, Faset): Use BOOL_VECTOR_BITS_PER_CHAR instead of
Andreas Schwab <schwab@suse.de>
parents: 54660
diff changeset
2143 XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val;
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2144 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2145 else if (CHAR_TABLE_P (array))
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2146 {
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2147 if (idxval < 0)
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2148 args_out_of_range (array, idx);
20827
4b85e02aae14 (Faref, Faset): Allow indexing a char-table
Richard M. Stallman <rms@gnu.org>
parents: 20793
diff changeset
2149 if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2150 {
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2151 if (! SINGLE_BYTE_CHAR_P (idxval))
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2152 args_out_of_range (array, idx);
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2153 XCHAR_TABLE (array)->contents[idxval] = newelt;
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2154 }
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2155 else
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2156 {
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2157 int code[4], i;
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2158 Lisp_Object val;
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2159
29007
180a8014aa14 (Faref): Use SPLIT_CHAR instead of SPLIT_NON_ASCII_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 28417
diff changeset
2160 SPLIT_CHAR (idxval, code[0], code[1], code[2]);
26849
a0ecda172035 (Faref): Delete codes for a composite character..
Kenichi Handa <handa@m17n.org>
parents: 26274
diff changeset
2161 if (code[1] < 32) code[1] = -1;
a0ecda172035 (Faref): Delete codes for a composite character..
Kenichi Handa <handa@m17n.org>
parents: 26274
diff changeset
2162 else if (code[2] < 32) code[2] = -1;
a0ecda172035 (Faref): Delete codes for a composite character..
Kenichi Handa <handa@m17n.org>
parents: 26274
diff changeset
2163
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2164 /* See the comment of the corresponding part in Faref. */
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2165 code[0] += 128;
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2166 code[3] = -1; /* anchor */
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2167 for (i = 0; code[i + 1] >= 0; i++)
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2168 {
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2169 val = XCHAR_TABLE (array)->contents[code[i]];
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2170 if (SUB_CHAR_TABLE_P (val))
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2171 array = val;
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2172 else
19751
19f79afe3e78 (Faset): Simplify a statement in the char-table case.
Richard M. Stallman <rms@gnu.org>
parents: 18854
diff changeset
2173 {
19f79afe3e78 (Faset): Simplify a statement in the char-table case.
Richard M. Stallman <rms@gnu.org>
parents: 18854
diff changeset
2174 Lisp_Object temp;
19f79afe3e78 (Faset): Simplify a statement in the char-table case.
Richard M. Stallman <rms@gnu.org>
parents: 18854
diff changeset
2175
19f79afe3e78 (Faset): Simplify a statement in the char-table case.
Richard M. Stallman <rms@gnu.org>
parents: 18854
diff changeset
2176 /* VAL is a leaf. Create a sub char table with the
61686
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2177 initial value VAL and look into it. */
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2178
527b912957bf (Faref): Handle special slots used as default values of
Kenichi Handa <handa@m17n.org>
parents: 60064
diff changeset
2179 temp = make_sub_char_table (val);
19751
19f79afe3e78 (Faset): Simplify a statement in the char-table case.
Richard M. Stallman <rms@gnu.org>
parents: 18854
diff changeset
2180 XCHAR_TABLE (array)->contents[code[i]] = temp;
19f79afe3e78 (Faset): Simplify a statement in the char-table case.
Richard M. Stallman <rms@gnu.org>
parents: 18854
diff changeset
2181 array = temp;
19f79afe3e78 (Faset): Simplify a statement in the char-table case.
Richard M. Stallman <rms@gnu.org>
parents: 18854
diff changeset
2182 }
17027
b1c4fbf1aee1 Include charset.h.
Karl Heuer <kwzh@gnu.org>
parents: 16945
diff changeset
2183 }
17319
a58d6ceeb370 (Faref, Faset): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17184
diff changeset
2184 XCHAR_TABLE (array)->contents[code[i]] = newelt;
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2185 }
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
2186 }
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
2187 else if (STRING_MULTIBYTE (array))
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
2188 {
50632
bd83590b911a (Faset): Calculate nbytes earlier, to satisfy the now pickier
Miles Bader <miles@gnu.org>
parents: 50314
diff changeset
2189 int idxval_byte, prev_bytes, new_bytes, nbytes;
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2190 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
2191
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2192 if (idxval < 0 || idxval >= SCHARS (array))
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
2193 args_out_of_range (array, idx);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2194 CHECK_NUMBER (newelt);
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
2195
50632
bd83590b911a (Faset): Calculate nbytes earlier, to satisfy the now pickier
Miles Bader <miles@gnu.org>
parents: 50314
diff changeset
2196 nbytes = SBYTES (array);
bd83590b911a (Faset): Calculate nbytes earlier, to satisfy the now pickier
Miles Bader <miles@gnu.org>
parents: 50314
diff changeset
2197
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
2198 idxval_byte = string_char_to_byte (array, idxval);
46422
50a2414d96b7 * data.c (Faref): Use SDATA.
Ken Raeburn <raeburn@raeburn.org>
parents: 46370
diff changeset
2199 p1 = SDATA (array) + idxval_byte;
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2200 PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes);
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2201 new_bytes = CHAR_STRING (XINT (newelt), p0);
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2202 if (prev_bytes != new_bytes)
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2203 {
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2204 /* We must relocate the string data. */
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2205 int nchars = SCHARS (array);
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2206 unsigned char *str;
56193
3310f9505840 (MAX_ALLOCA): Remove define.
Kim F. Storm <storm@cua.dk>
parents: 55616
diff changeset
2207 USE_SAFE_ALLOCA;
3310f9505840 (MAX_ALLOCA): Remove define.
Kim F. Storm <storm@cua.dk>
parents: 55616
diff changeset
2208
3310f9505840 (MAX_ALLOCA): Remove define.
Kim F. Storm <storm@cua.dk>
parents: 55616
diff changeset
2209 SAFE_ALLOCA (str, unsigned char *, nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2210 bcopy (SDATA (array), str, nbytes);
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2211 allocate_string_data (XSTRING (array), nchars,
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2212 nbytes + new_bytes - prev_bytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2213 bcopy (str, SDATA (array), idxval_byte);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2214 p1 = SDATA (array) + idxval_byte;
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2215 bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2216 nbytes - (idxval_byte + prev_bytes));
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57618
diff changeset
2217 SAFE_FREE ();
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2218 clear_string_char_byte_cache ();
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2219 }
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2220 while (new_bytes--)
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2221 *p1++ = *p0++;
20617
20957e3ca2f5 (Fmultibyte_string_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20122
diff changeset
2222 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2223 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2224 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2225 if (idxval < 0 || idxval >= SCHARS (array))
9966
d64bdd958254 (Farray_length): Delete this obsolete function.
Karl Heuer <kwzh@gnu.org>
parents: 9954
diff changeset
2226 args_out_of_range (array, idx);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2227 CHECK_NUMBER (newelt);
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2228
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2229 if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt)))
46422
50a2414d96b7 * data.c (Faref): Use SDATA.
Ken Raeburn <raeburn@raeburn.org>
parents: 46370
diff changeset
2230 SSET (array, idxval, XINT (newelt));
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2231 else
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2232 {
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2233 /* We must relocate the string data while converting it to
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2234 multibyte. */
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2235 int idxval_byte, prev_bytes, new_bytes;
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2236 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2237 unsigned char *origstr = SDATA (array), *str;
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2238 int nchars, nbytes;
56193
3310f9505840 (MAX_ALLOCA): Remove define.
Kim F. Storm <storm@cua.dk>
parents: 55616
diff changeset
2239 USE_SAFE_ALLOCA;
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2240
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2241 nchars = SCHARS (array);
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2242 nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval);
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2243 nbytes += count_size_as_multibyte (origstr + idxval,
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2244 nchars - idxval);
56193
3310f9505840 (MAX_ALLOCA): Remove define.
Kim F. Storm <storm@cua.dk>
parents: 55616
diff changeset
2245 SAFE_ALLOCA (str, unsigned char *, nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2246 copy_text (SDATA (array), str, nchars, 0, 1);
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2247 PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte,
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2248 prev_bytes);
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2249 new_bytes = CHAR_STRING (XINT (newelt), p0);
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2250 allocate_string_data (XSTRING (array), nchars,
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2251 nbytes + new_bytes - prev_bytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2252 bcopy (str, SDATA (array), idxval_byte);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2253 p1 = SDATA (array) + idxval_byte;
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2254 while (new_bytes--)
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2255 *p1++ = *p0++;
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2256 bcopy (str + idxval_byte + prev_bytes, p1,
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2257 nbytes - (idxval_byte + prev_bytes));
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57618
diff changeset
2258 SAFE_FREE ();
30356
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2259 clear_string_char_byte_cache ();
b600a31684db (Faset): Allow storing any multibyte character in a string. Convert
Kenichi Handa <handa@m17n.org>
parents: 29735
diff changeset
2260 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2261 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2262
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2263 return newelt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2264 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2265
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2266 /* Arithmetic functions */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2267
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2268 enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2269
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2270 Lisp_Object
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2271 arithcompare (num1, num2, comparison)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2272 Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2273 enum comparison comparison;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2274 {
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 30356
diff changeset
2275 double f1 = 0, f2 = 0;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2276 int floatp = 0;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2277
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2278 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2279 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2280
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
2281 if (FLOATP (num1) || FLOATP (num2))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2282 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2283 floatp = 1;
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2284 f1 = (FLOATP (num1)) ? XFLOAT_DATA (num1) : XINT (num1);
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2285 f2 = (FLOATP (num2)) ? XFLOAT_DATA (num2) : XINT (num2);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2286 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2287
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2288 switch (comparison)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2289 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2290 case equal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2291 if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2292 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2293 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2294
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2295 case notequal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2296 if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2297 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2298 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2299
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2300 case less:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2301 if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2302 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2303 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2304
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2305 case less_or_equal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2306 if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2307 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2308 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2309
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2310 case grtr:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2311 if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2312 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2313 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2314
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2315 case grtr_or_equal:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2316 if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2317 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2318 return Qnil;
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2319
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2320 default:
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2321 abort ();
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2322 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2323 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2324
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2325 DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2326 doc: /* Return t if two args, both numbers or markers, are equal. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2327 (num1, num2)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2328 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2329 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2330 return arithcompare (num1, num2, equal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2331 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2332
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2333 DEFUN ("<", Flss, Slss, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2334 doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2335 (num1, num2)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2336 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2337 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2338 return arithcompare (num1, num2, less);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2339 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2340
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2341 DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2342 doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2343 (num1, num2)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2344 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2345 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2346 return arithcompare (num1, num2, grtr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2347 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2348
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2349 DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2350 doc: /* Return t if first arg is less than or equal to second arg.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2351 Both must be numbers or markers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2352 (num1, num2)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2355 return arithcompare (num1, num2, less_or_equal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2356 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2357
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2358 DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2359 doc: /* Return t if first arg is greater than or equal to second arg.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2360 Both must be numbers or markers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2361 (num1, num2)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2362 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2363 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2364 return arithcompare (num1, num2, grtr_or_equal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2365 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2366
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2367 DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2368 doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2369 (num1, num2)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2370 register Lisp_Object num1, num2;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2371 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2372 return arithcompare (num1, num2, notequal);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2373 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2374
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2375 DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2376 doc: /* Return t if NUMBER is zero. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2377 (number)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2378 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2379 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2380 CHECK_NUMBER_OR_FLOAT (number);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2381
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2382 if (FLOATP (number))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2383 {
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2384 if (XFLOAT_DATA (number) == 0.0)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2385 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2386 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2387 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2388
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2389 if (!XINT (number))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2390 return Qt;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2391 return Qnil;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2392 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2393
12043
4aed79cc70b7 Comment change.
Karl Heuer <kwzh@gnu.org>
parents: 11879
diff changeset
2394 /* Convert between long values and pairs of Lisp integers. */
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2395
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2396 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
2397 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
2398 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
2399 {
50109
d23ab2416c49 (long_to_cons): Fix type of top.
Andreas Schwab <schwab@suse.de>
parents: 48996
diff changeset
2400 unsigned long top = i >> 16;
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2401 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
2402 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
2403 return make_number (bot);
11879
606889516975 (long_to_cons): Don't assume 32-bit longs.
Karl Heuer <kwzh@gnu.org>
parents: 11734
diff changeset
2404 if (top == (unsigned long)-1 >> 16)
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2405 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
2406 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
2407 }
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2408
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2409 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
2410 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
2411 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
2412 {
3675
f42eaf84478f (cons_to_long): Declare top, bot as Lisp_Object.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
2413 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
2414 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
2415 return XINT (c);
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2416 top = XCAR (c);
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2417 bot = XCDR (c);
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2418 if (CONSP (bot))
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2419 bot = XCAR (bot);
2515
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2420 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
2421 }
c0cdd6a80391 long_to_cons and cons_to_long are generally useful things; they're
Jim Blandy <jimb@redhat.com>
parents: 2429
diff changeset
2422
2429
96b55f2f19cd Rename int-to-string to number-to-string, since it can handle
Jim Blandy <jimb@redhat.com>
parents: 2092
diff changeset
2423 DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
2424 doc: /* Return the decimal representation of NUMBER as a string.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2425 Uses a minus sign if negative.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2426 NUMBER may be an integer or a floating point number. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2427 (number)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2428 Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2429 {
12528
ed5b91dd829a (Fnumber_to_string): Make `buffer' long enough.
Karl Heuer <kwzh@gnu.org>
parents: 12295
diff changeset
2430 char buffer[VALBITS];
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2431
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2432 CHECK_NUMBER_OR_FLOAT (number);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2433
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2434 if (FLOATP (number))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2435 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2436 char pigbuf[350]; /* see comments in float_to_string */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2437
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2438 float_to_string (pigbuf, XFLOAT_DATA (number));
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
2439 return build_string (pigbuf);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2440 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2441
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
2442 if (sizeof (int) == sizeof (EMACS_INT))
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2443 sprintf (buffer, "%d", XINT (number));
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
2444 else if (sizeof (long) == sizeof (EMACS_INT))
25780
18cf58ed9400 (find_symbol_value): Remove unused variables.
Gerd Moellmann <gerd@gnu.org>
parents: 25665
diff changeset
2445 sprintf (buffer, "%ld", (long) XINT (number));
11701
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
2446 else
d0eaa6b6dc72 (Fnumber_to_string, Fstring_to_number):
Richard M. Stallman <rms@gnu.org>
parents: 11688
diff changeset
2447 abort ();
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2448 return build_string (buffer);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2449 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2450
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2451 INLINE static int
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2452 digit_to_number (character, base)
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2453 int character, base;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2454 {
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2455 int digit;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2456
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2457 if (character >= '0' && character <= '9')
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2458 digit = character - '0';
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2459 else if (character >= 'a' && character <= 'z')
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2460 digit = character - 'a' + 10;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2461 else if (character >= 'A' && character <= 'Z')
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2462 digit = character - 'A' + 10;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2463 else
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2464 return -1;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2465
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2466 if (digit >= base)
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2467 return -1;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2468 else
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2469 return digit;
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
2470 }
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2471
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2472 DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
48996
7931f73b31db (Fstring_to_number, Fminus): Better English in doc strings.
Francesco Potortì <pot@gnu.org>
parents: 48961
diff changeset
2473 doc: /* Parse STRING as a decimal number and return the number.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2474 This parses both integers and floating point numbers.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2475 It ignores leading spaces and tabs.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2476
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2477 If BASE, interpret STRING as a number in that base. If BASE isn't
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2478 present, base 10 is used. BASE must be between 2 and 16 (inclusive).
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2479 If the base used is not 10, floating point is not recognized. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2480 (string, base)
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2481 register Lisp_Object string, base;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2482 {
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2483 register unsigned char *p;
27826
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2484 register int b;
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2485 int sign = 1;
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2486 Lisp_Object val;
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2487
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2488 CHECK_STRING (string);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2489
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2490 if (NILP (base))
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2491 b = 10;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2492 else
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2493 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2494 CHECK_NUMBER (base);
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2495 b = XINT (base);
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2496 if (b < 2 || b > 16)
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2497 Fsignal (Qargs_out_of_range, Fcons (base, Qnil));
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2498 }
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2499
1914
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2500 /* 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
2501 atoi do this anyway, so we might as well make Emacs lisp consistent. */
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46279
diff changeset
2502 p = SDATA (string);
1987
cd893024d6b9 * data.c (Fstring_to_number): Declare p to be an unsigned char, to
Jim Blandy <jimb@redhat.com>
parents: 1914
diff changeset
2503 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
2504 p++;
60965a5c325f * data.c (Fstring_to_number): Skip initial spaces, to make Emacs
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2505
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2506 if (*p == '-')
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2507 {
27826
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2508 sign = -1;
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2509 p++;
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2510 }
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2511 else if (*p == '+')
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2512 p++;
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
2513
23420
460aba3ec682 (Fstring_to_number): Don't recognize floating point if base is not 10.
Kenichi Handa <handa@m17n.org>
parents: 23250
diff changeset
2514 if (isfloat_string (p) && b == 10)
27826
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2515 val = make_float (sign * atof (p));
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2516 else
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2517 {
27826
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2518 double v = 0;
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2519
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2520 while (1)
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2521 {
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2522 int digit = digit_to_number (*p++, b);
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2523 if (digit < 0)
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2524 break;
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2525 v = v * b + digit;
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2526 }
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2527
39775
280975f8c65e (Fstring_to_number): Use make_fixnum_or_float.
Gerd Moellmann <gerd@gnu.org>
parents: 39767
diff changeset
2528 val = make_fixnum_or_float (sign * v);
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2529 }
27826
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2530
1a0a62bd23c4 (Fstring_to_number): If number is greater than what
Gerd Moellmann <gerd@gnu.org>
parents: 27818
diff changeset
2531 return val;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2532 }
17780
df8d082029a6 (wrong_type_argument): Pass new arg to Fstring_to_number.
Richard M. Stallman <rms@gnu.org>
parents: 17319
diff changeset
2533
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
2534
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2535 enum arithop
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2536 {
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2537 Aadd,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2538 Asub,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2539 Amult,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2540 Adiv,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2541 Alogand,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2542 Alogior,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2543 Alogxor,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2544 Amax,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2545 Amin
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2546 };
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2547
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2548 static Lisp_Object float_arith_driver P_ ((double, int, enum arithop,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2549 int, Lisp_Object *));
16787
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
2550 extern Lisp_Object fmod_float ();
1508
768d4c10c2bf * data.c (Fset): See if current_alist_element points to itself
Jim Blandy <jimb@redhat.com>
parents: 1293
diff changeset
2551
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2552 Lisp_Object
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2553 arith_driver (code, nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2554 enum arithop code;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2555 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2556 register Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2557 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2558 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2559 register int argnum;
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2560 register EMACS_INT accum = 0;
11688
f1e6033d8aca (arith_driver): Make accum and next EMACS_INTs.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
2561 register EMACS_INT next;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2562
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
2563 switch (SWITCH_ENUM_CAST (code))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2564 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2565 case Alogior:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2566 case Alogxor:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2567 case Aadd:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2568 case Asub:
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2569 accum = 0;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2570 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2571 case Amult:
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2572 accum = 1;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2573 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2574 case Alogand:
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2575 accum = -1;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2576 break;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2577 default:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2578 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2579 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2580
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2581 for (argnum = 0; argnum < nargs; argnum++)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2582 {
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2583 /* Using args[argnum] as argument to CHECK_NUMBER_... */
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2584 val = args[argnum];
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2585 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2586
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2587 if (FLOATP (val))
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2588 return float_arith_driver ((double) accum, argnum, code,
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2589 nargs, args);
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2590 args[argnum] = val;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2591 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
2592 switch (SWITCH_ENUM_CAST (code))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2593 {
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2594 case Aadd:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2595 accum += next;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2596 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2597 case Asub:
23148
10e261360159 (arith_driver, float_arith_driver): Compute (- x) by
Paul Eggert <eggert@twinsun.com>
parents: 23129
diff changeset
2598 accum = argnum ? accum - next : nargs == 1 ? - next : next;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2599 break;
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2600 case Amult:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2601 accum *= next;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2602 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2603 case Adiv:
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2604 if (!argnum)
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2605 accum = next;
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2606 else
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2607 {
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2608 if (next == 0)
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2609 Fsignal (Qarith_error, Qnil);
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2610 accum /= next;
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2611 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2612 break;
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2613 case Alogand:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2614 accum &= next;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2615 break;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2616 case Alogior:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2617 accum |= next;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2618 break;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2619 case Alogxor:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2620 accum ^= next;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2621 break;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2622 case Amax:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2623 if (!argnum || next > accum)
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2624 accum = next;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2625 break;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2626 case Amin:
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2627 if (!argnum || next < accum)
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2628 accum = next;
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2629 break;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2630 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2631 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2632
9263
cda13734e32c (make_number, Fsymbol_name, do_symval_forwarding, swap_in_symval_forwarding,
Karl Heuer <kwzh@gnu.org>
parents: 9194
diff changeset
2633 XSETINT (val, accum);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2634 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2635 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2636
6201
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2637 #undef isnan
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2638 #define isnan(x) ((x) != (x))
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2639
36819
c21e776b768a (store_symval_forwarding): Add parameter BUF. If BUF is
Gerd Moellmann <gerd@gnu.org>
parents: 34964
diff changeset
2640 static Lisp_Object
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2641 float_arith_driver (accum, argnum, code, nargs, args)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2642 double accum;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2643 register int argnum;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2644 enum arithop code;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2645 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2646 register Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2647 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2648 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2649 double next;
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
2650
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2651 for (; argnum < nargs; argnum++)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2652 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2653 val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2654 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2655
9147
ee9adbda1ad1 (wrong_type_argument, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp, Fvectorp,
Karl Heuer <kwzh@gnu.org>
parents: 9035
diff changeset
2656 if (FLOATP (val))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2657 {
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2658 next = XFLOAT_DATA (val);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2659 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2660 else
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2661 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2662 args[argnum] = val; /* runs into a compiler bug. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2663 next = XINT (args[argnum]);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2664 }
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10290
diff changeset
2665 switch (SWITCH_ENUM_CAST (code))
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2666 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2667 case Aadd:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2668 accum += next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2669 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2670 case Asub:
23148
10e261360159 (arith_driver, float_arith_driver): Compute (- x) by
Paul Eggert <eggert@twinsun.com>
parents: 23129
diff changeset
2671 accum = argnum ? accum - next : nargs == 1 ? - next : next;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2672 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2673 case Amult:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2674 accum *= next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2675 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2676 case Adiv:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2677 if (!argnum)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2678 accum = next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2679 else
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2680 {
16787
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
2681 if (! IEEE_FLOATING_POINT && next == 0)
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2682 Fsignal (Qarith_error, Qnil);
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2683 accum /= next;
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2684 }
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2685 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2686 case Alogand:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2687 case Alogior:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2688 case Alogxor:
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2689 return wrong_type_argument (Qinteger_or_marker_p, val);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2690 case Amax:
6201
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2691 if (!argnum || isnan (next) || next > accum)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2692 accum = next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2693 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2694 case Amin:
6201
d71dedd123c1 (isnan): New macro.
Karl Heuer <kwzh@gnu.org>
parents: 5776
diff changeset
2695 if (!argnum || isnan (next) || next < accum)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2696 accum = next;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2697 break;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2698 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2699 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2700
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2701 return make_float (accum);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2702 }
27727
9400865ec7cf Remove `LISP_FLOAT_TYPE' and `standalone'.
Gerd Moellmann <gerd@gnu.org>
parents: 27703
diff changeset
2703
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2704
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2705 DEFUN ("+", Fplus, Splus, 0, MANY, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2706 doc: /* Return sum of any number of arguments, which are numbers or markers.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2707 usage: (+ &rest NUMBERS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2708 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2709 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2710 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2711 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2712 return arith_driver (Aadd, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2713 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2714
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2715 DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
48996
7931f73b31db (Fstring_to_number, Fminus): Better English in doc strings.
Francesco Potortì <pot@gnu.org>
parents: 48961
diff changeset
2716 doc: /* Negate number or subtract numbers or markers and return the result.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2717 With one arg, negates it. With more than one arg,
40116
528dd5f565ba (Fplus, Fminus, Fmax, Ftimes, Fquo, Flogand, Flogior, Flogxor):
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2718 subtracts all but the first from the first.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2719 usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2720 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2721 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2722 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2723 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2724 return arith_driver (Asub, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2725 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2726
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2727 DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
41153
204630ee6402 (Ftimes): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 40656
diff changeset
2728 doc: /* Return product of any number of arguments, which are numbers or markers.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2729 usage: (* &rest NUMBERS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2730 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2731 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2732 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2733 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2734 return arith_driver (Amult, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2735 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2736
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2737 DEFUN ("/", Fquo, Squo, 2, MANY, 0,
41153
204630ee6402 (Ftimes): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 40656
diff changeset
2738 doc: /* Return first argument divided by all the remaining arguments.
40116
528dd5f565ba (Fplus, Fminus, Fmax, Ftimes, Fquo, Flogand, Flogior, Flogxor):
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2739 The arguments must be numbers or markers.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2740 usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2741 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2742 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2743 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2744 {
55440
1ca30263e9d4 (Fquo): If any argument is float, do the computation in floating point.
Juanma Barranquero <lekktu@gmail.com>
parents: 55378
diff changeset
2745 int argnum;
55455
c1c4318a2189 (Fquo): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 55440
diff changeset
2746 for (argnum = 2; argnum < nargs; argnum++)
55440
1ca30263e9d4 (Fquo): If any argument is float, do the computation in floating point.
Juanma Barranquero <lekktu@gmail.com>
parents: 55378
diff changeset
2747 if (FLOATP (args[argnum]))
1ca30263e9d4 (Fquo): If any argument is float, do the computation in floating point.
Juanma Barranquero <lekktu@gmail.com>
parents: 55378
diff changeset
2748 return float_arith_driver (0, 0, Adiv, nargs, args);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2749 return arith_driver (Adiv, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2750 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2751
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2752 DEFUN ("%", Frem, Srem, 2, 2, 0,
41153
204630ee6402 (Ftimes): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 40656
diff changeset
2753 doc: /* Return remainder of X divided by Y.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2754 Both must be integers or markers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2755 (x, y)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2756 register Lisp_Object x, y;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2757 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2758 Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2759
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2760 CHECK_NUMBER_COERCE_MARKER (x);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2761 CHECK_NUMBER_COERCE_MARKER (y);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2762
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2763 if (XFASTINT (y) == 0)
3338
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2764 Fsignal (Qarith_error, Qnil);
30b946dd8c66 (float_arith_driver): Detect division by zero in advance.
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
2765
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2766 XSETINT (val, XINT (x) % XINT (y));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2767 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2768 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2769
5776
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2770 #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
2771 double
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2772 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
2773 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
2774 {
16945
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2775 double r = f1;
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2776
13296
76034e1fc62e [!HAVE_FMOD] (fmod): Make consistent with ANSI definition.
Karl Heuer <kwzh@gnu.org>
parents: 13200
diff changeset
2777 if (f2 < 0.0)
76034e1fc62e [!HAVE_FMOD] (fmod): Make consistent with ANSI definition.
Karl Heuer <kwzh@gnu.org>
parents: 13200
diff changeset
2778 f2 = -f2;
16945
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2779
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2780 /* If the magnitude of the result exceeds that of the divisor, or
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2781 the sign of the result does not agree with that of the dividend,
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2782 iterate with the reduced value. This does not yield a
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2783 particularly accurate result, but at least it will be in the
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2784 range promised by fmod. */
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2785 do
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2786 r -= f2 * floor (r / f2);
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2787 while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2788
d6cd00b2e214 (isnan): Define even if LISP_FLOAT_TYPE is not defined, since fmod
Paul Eggert <eggert@twinsun.com>
parents: 16931
diff changeset
2789 return r;
5776
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2790 }
6130ebde8d3b (fmod): Implement it on systems where it's missing, using drem if available.
Karl Heuer <kwzh@gnu.org>
parents: 5729
diff changeset
2791 #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
2792
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2793 DEFUN ("mod", Fmod, Smod, 2, 2, 0,
41153
204630ee6402 (Ftimes): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 40656
diff changeset
2794 doc: /* Return X modulo Y.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2795 The result falls between zero (inclusive) and Y (exclusive).
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2796 Both X and Y must be numbers or markers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2797 (x, y)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2798 register Lisp_Object x, y;
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2799 {
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2800 Lisp_Object val;
11688
f1e6033d8aca (arith_driver): Make accum and next EMACS_INTs.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
2801 EMACS_INT i1, i2;
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2802
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2803 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2804 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2805
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2806 if (FLOATP (x) || FLOATP (y))
16787
3ad557e686b9 <float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents: 16756
diff changeset
2807 return fmod_float (x, y);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2808
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2809 i1 = XINT (x);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2810 i2 = XINT (y);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2811
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2812 if (i2 == 0)
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2813 Fsignal (Qarith_error, Qnil);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
2814
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2815 i1 %= i2;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2816
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2817 /* 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
2818 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
2819 i1 += i2;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2820
9263
cda13734e32c (make_number, Fsymbol_name, do_symval_forwarding, swap_in_symval_forwarding,
Karl Heuer <kwzh@gnu.org>
parents: 9194
diff changeset
2821 XSETINT (val, i1);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2822 return val;
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2823 }
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
2824
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2825 DEFUN ("max", Fmax, Smax, 1, MANY, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2826 doc: /* Return largest of all the arguments (which must be numbers or markers).
40116
528dd5f565ba (Fplus, Fminus, Fmax, Ftimes, Fquo, Flogand, Flogior, Flogxor):
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2827 The value is always a number; markers are converted to numbers.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2828 usage: (max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2829 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2830 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2831 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2832 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2833 return arith_driver (Amax, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2834 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2835
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2836 DEFUN ("min", Fmin, Smin, 1, MANY, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2837 doc: /* Return smallest of all the arguments (which must be numbers or markers).
40116
528dd5f565ba (Fplus, Fminus, Fmax, Ftimes, Fquo, Flogand, Flogior, Flogxor):
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2838 The value is always a number; markers are converted to numbers.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2839 usage: (min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2840 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2841 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2842 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2843 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2844 return arith_driver (Amin, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2845 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2846
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2847 DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2848 doc: /* Return bitwise-and of all the arguments.
40116
528dd5f565ba (Fplus, Fminus, Fmax, Ftimes, Fquo, Flogand, Flogior, Flogxor):
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2849 Arguments may be integers, or markers converted to integers.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2850 usage: (logand &rest INTS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2851 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2852 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2853 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2854 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2855 return arith_driver (Alogand, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2856 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2857
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2858 DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2859 doc: /* Return bitwise-or of all the arguments.
40116
528dd5f565ba (Fplus, Fminus, Fmax, Ftimes, Fquo, Flogand, Flogior, Flogxor):
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2860 Arguments may be integers, or markers converted to integers.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2861 usage: (logior &rest INTS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2862 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2863 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2864 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2865 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2866 return arith_driver (Alogior, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2867 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2868
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2869 DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2870 doc: /* Return bitwise-exclusive-or of all the arguments.
40116
528dd5f565ba (Fplus, Fminus, Fmax, Ftimes, Fquo, Flogand, Flogior, Flogxor):
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2871 Arguments may be integers, or markers converted to integers.
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2872 usage: (logxor &rest INTS-OR-MARKERS) */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2873 (nargs, args)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2874 int nargs;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2875 Lisp_Object *args;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2876 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2877 return arith_driver (Alogxor, nargs, args);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2878 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2879
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2880 DEFUN ("ash", Fash, Sash, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2881 doc: /* Return VALUE with its bits shifted left by COUNT.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2882 If COUNT is negative, shifting is actually to the right.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2883 In this case, the sign bit is duplicated. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2884 (value, count)
11002
ff115809a39e (Fash): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 10951
diff changeset
2885 register Lisp_Object value, count;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2886 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2887 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2888
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2889 CHECK_NUMBER (value);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2890 CHECK_NUMBER (count);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2891
21819
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2892 if (XINT (count) >= BITS_PER_EMACS_INT)
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2893 XSETINT (val, 0);
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2894 else if (XINT (count) > 0)
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2895 XSETINT (val, XINT (value) << XFASTINT (count));
21819
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2896 else if (XINT (count) <= -BITS_PER_EMACS_INT)
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2897 XSETINT (val, XINT (value) < 0 ? -1 : 0);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2898 else
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2899 XSETINT (val, XINT (value) >> -XINT (count));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2900 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2901 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2902
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2903 DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2904 doc: /* Return VALUE with its bits shifted left by COUNT.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2905 If COUNT is negative, shifting is actually to the right.
47276
fbe02a367006 (Flsh): Fix spacing.
Juanma Barranquero <lekktu@gmail.com>
parents: 46831
diff changeset
2906 In this case, zeros are shifted in on the left. */)
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2907 (value, count)
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2908 register Lisp_Object value, count;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2909 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2910 register Lisp_Object val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2911
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2912 CHECK_NUMBER (value);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2913 CHECK_NUMBER (count);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2914
21819
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2915 if (XINT (count) >= BITS_PER_EMACS_INT)
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2916 XSETINT (val, 0);
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2917 else if (XINT (count) > 0)
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2918 XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
21819
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2919 else if (XINT (count) <= -BITS_PER_EMACS_INT)
c98ba82f4b52 (Flsh, Fash): Handle out-of-range shift counts reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 21775
diff changeset
2920 XSETINT (val, 0);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2921 else
10951
6a8b6db450dc (Fash, Flsh): Change arg names.
Richard M. Stallman <rms@gnu.org>
parents: 10725
diff changeset
2922 XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2923 return val;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2924 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2925
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2926 DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2927 doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2928 Markers are converted to integers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2929 (number)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2930 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2931 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2932 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2933
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2934 if (FLOATP (number))
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2935 return (make_float (1.0 + XFLOAT_DATA (number)));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2936
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2937 XSETINT (number, XINT (number) + 1);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2938 return number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2939 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2940
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2941 DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2942 doc: /* Return NUMBER minus one. NUMBER may be a number or a marker.
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2943 Markers are converted to integers. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2944 (number)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2945 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2946 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2947 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number);
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2948
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2949 if (FLOATP (number))
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
2950 return (make_float (-1.0 + XFLOAT_DATA (number)));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2951
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2952 XSETINT (number, XINT (number) - 1);
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2953 return number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2954 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2955
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2956 DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
40123
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2957 doc: /* Return the bitwise complement of NUMBER. NUMBER must be an integer. */)
e528f2adeed4 Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents: 40116
diff changeset
2958 (number)
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2959 register Lisp_Object number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2960 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40642
diff changeset
2961 CHECK_NUMBER (number);
14096
f3766d691555 (Flognot): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 14066
diff changeset
2962 XSETINT (number, ~XINT (number));
14066
2c6db67067ac (Fboundp, Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_plist, Fsymbol_name,
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2963 return number;
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2964 }
53910
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2965
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2966 DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2967 doc: /* Return the byteorder for the machine.
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2968 Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2969 lowercase l) for small endian machines. */)
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2970 ()
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2971 {
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2972 unsigned i = 0x04030201;
54660
122a60d4f165 data.c (Fbyteorder): Make test work even if unsigned is not 4 bytes.
Jan Djärv <jan.h.d@swipnet.se>
parents: 54627
diff changeset
2973 int order = *(char *)&i == 1 ? 108 : 66;
53910
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2974
53966
26dc8943ee64 Lisp_Object/int mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53910
diff changeset
2975 return make_number (order);
53910
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2976 }
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2977
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
2978
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2979
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2980 void
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2981 syms_of_data ()
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2982 {
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
2983 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
2984
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2985 Qquote = intern ("quote");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2986 Qlambda = intern ("lambda");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2987 Qsubr = intern ("subr");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2988 Qerror_conditions = intern ("error-conditions");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2989 Qerror_message = intern ("error-message");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2990 Qtop_level = intern ("top-level");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2991
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2992 Qerror = intern ("error");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2993 Qquit = intern ("quit");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2994 Qwrong_type_argument = intern ("wrong-type-argument");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2995 Qargs_out_of_range = intern ("args-out-of-range");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2996 Qvoid_function = intern ("void-function");
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
2997 Qcyclic_function_indirection = intern ("cyclic-function-indirection");
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
2998 Qcyclic_variable_indirection = intern ("cyclic-variable-indirection");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2999 Qvoid_variable = intern ("void-variable");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3000 Qsetting_constant = intern ("setting-constant");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3001 Qinvalid_read_syntax = intern ("invalid-read-syntax");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3002
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3003 Qinvalid_function = intern ("invalid-function");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3004 Qwrong_number_of_arguments = intern ("wrong-number-of-arguments");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3005 Qno_catch = intern ("no-catch");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3006 Qend_of_file = intern ("end-of-file");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3007 Qarith_error = intern ("arith-error");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3008 Qbeginning_of_buffer = intern ("beginning-of-buffer");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3009 Qend_of_buffer = intern ("end-of-buffer");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3010 Qbuffer_read_only = intern ("buffer-read-only");
26274
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
3011 Qtext_read_only = intern ("text-read-only");
4036
fbbd3e138284 Define Qmark_inactive.
Roland McGrath <roland@gnu.org>
parents: 3675
diff changeset
3012 Qmark_inactive = intern ("mark-inactive");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3013
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3014 Qlistp = intern ("listp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3015 Qconsp = intern ("consp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3016 Qsymbolp = intern ("symbolp");
26931
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
3017 Qkeywordp = intern ("keywordp");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3018 Qintegerp = intern ("integerp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3019 Qnatnump = intern ("natnump");
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
3020 Qwholenump = intern ("wholenump");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3021 Qstringp = intern ("stringp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3022 Qarrayp = intern ("arrayp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3023 Qsequencep = intern ("sequencep");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3024 Qbufferp = intern ("bufferp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3025 Qvectorp = intern ("vectorp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3026 Qchar_or_string_p = intern ("char-or-string-p");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3027 Qmarkerp = intern ("markerp");
1293
95ae0805ebba Qbuffer_or_string_p added.
Joseph Arceneaux <jla@gnu.org>
parents: 1278
diff changeset
3028 Qbuffer_or_string_p = intern ("buffer-or-string-p");
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3029 Qinteger_or_marker_p = intern ("integer-or-marker-p");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3030 Qboundp = intern ("boundp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3031 Qfboundp = intern ("fboundp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3032
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3033 Qfloatp = intern ("floatp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3034 Qnumberp = intern ("numberp");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3035 Qnumber_or_marker_p = intern ("number-or-marker-p");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3036
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
3037 Qchar_table_p = intern ("char-table-p");
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
3038 Qvector_or_char_table_p = intern ("vector-or-char-table-p");
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
3039
29237
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3040 Qsubrp = intern ("subrp");
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3041 Qunevalled = intern ("unevalled");
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3042 Qmany = intern ("many");
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3043
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3044 Qcdr = intern ("cdr");
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3045
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
3046 /* Handle automatic advice activation */
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
3047 Qad_advice_info = intern ("ad-advice-info");
26205
65a0abaeed68 (Qad_activate_internal): Renamed from Qad_activate.
Gerd Moellmann <gerd@gnu.org>
parents: 26185
diff changeset
3048 Qad_activate_internal = intern ("ad-activate-internal");
8401
1eee41c8120c (syms_of_data): Set up Qadvice_info, Qactivate_advice.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
3049
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3050 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
3051
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3052 /* 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
3053
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3054 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
3055 error_tail);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3056 Fput (Qerror, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3057 build_string ("error"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3058
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3059 Fput (Qquit, Qerror_conditions,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3060 Fcons (Qquit, Qnil));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3061 Fput (Qquit, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3062 build_string ("Quit"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3063
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3064 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
3065 Fcons (Qwrong_type_argument, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3066 Fput (Qwrong_type_argument, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3067 build_string ("Wrong type argument"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3068
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3069 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
3070 Fcons (Qargs_out_of_range, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3071 Fput (Qargs_out_of_range, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3072 build_string ("Args out of range"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3073
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3074 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
3075 Fcons (Qvoid_function, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3076 Fput (Qvoid_function, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3077 build_string ("Symbol's function definition is void"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3078
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3079 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
3080 Fcons (Qcyclic_function_indirection, error_tail));
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3081 Fput (Qcyclic_function_indirection, Qerror_message,
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3082 build_string ("Symbol's chain of function indirections contains a loop"));
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3083
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
3084 Fput (Qcyclic_variable_indirection, Qerror_conditions,
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
3085 Fcons (Qcyclic_variable_indirection, error_tail));
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
3086 Fput (Qcyclic_variable_indirection, Qerror_message,
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
3087 build_string ("Symbol's chain of variable indirections contains a loop"));
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
3088
39767
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
3089 Qcircular_list = intern ("circular-list");
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
3090 staticpro (&Qcircular_list);
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
3091 Fput (Qcircular_list, Qerror_conditions,
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
3092 Fcons (Qcircular_list, error_tail));
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
3093 Fput (Qcircular_list, Qerror_message,
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
3094 build_string ("List contains a loop"));
00f499d0cd16 (Qcircular_list): New variable.
Gerd Moellmann <gerd@gnu.org>
parents: 39632
diff changeset
3095
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3096 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
3097 Fcons (Qvoid_variable, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3098 Fput (Qvoid_variable, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3099 build_string ("Symbol's value as variable is void"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3100
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3101 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
3102 Fcons (Qsetting_constant, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3103 Fput (Qsetting_constant, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3104 build_string ("Attempt to set a constant symbol"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3105
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3106 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
3107 Fcons (Qinvalid_read_syntax, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3108 Fput (Qinvalid_read_syntax, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3109 build_string ("Invalid read syntax"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3110
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3111 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
3112 Fcons (Qinvalid_function, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3113 Fput (Qinvalid_function, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3114 build_string ("Invalid function"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3115
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3116 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
3117 Fcons (Qwrong_number_of_arguments, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3118 Fput (Qwrong_number_of_arguments, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3119 build_string ("Wrong number of arguments"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3120
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3121 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
3122 Fcons (Qno_catch, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3123 Fput (Qno_catch, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3124 build_string ("No catch for tag"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3125
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3126 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
3127 Fcons (Qend_of_file, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3128 Fput (Qend_of_file, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3129 build_string ("End of file during parsing"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3130
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3131 arith_tail = Fcons (Qarith_error, error_tail);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3132 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
3133 arith_tail);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3134 Fput (Qarith_error, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3135 build_string ("Arithmetic error"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3136
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3137 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
3138 Fcons (Qbeginning_of_buffer, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3139 Fput (Qbeginning_of_buffer, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3140 build_string ("Beginning of buffer"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3141
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3142 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
3143 Fcons (Qend_of_buffer, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3144 Fput (Qend_of_buffer, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3145 build_string ("End of buffer"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3146
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3147 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
3148 Fcons (Qbuffer_read_only, error_tail));
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3149 Fput (Qbuffer_read_only, Qerror_message,
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3150 build_string ("Buffer is read-only"));
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3151
26274
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
3152 Fput (Qtext_read_only, Qerror_conditions,
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
3153 Fcons (Qtext_read_only, error_tail));
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
3154 Fput (Qtext_read_only, Qerror_message,
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
3155 build_string ("Text is read-only"));
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
3156
2092
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3157 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
3158 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
3159 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
3160 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
3161 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
3162
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3163 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
3164 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
3165 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
3166 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
3167
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3168 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
3169 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
3170 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
3171 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
3172
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3173 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
3174 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
3175 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
3176 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
3177
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3178 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
3179 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
3180 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
3181 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
3182
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3183 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
3184 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
3185 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
3186 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
3187
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3188 staticpro (&Qrange_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3189 staticpro (&Qdomain_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3190 staticpro (&Qsingularity_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3191 staticpro (&Qoverflow_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3192 staticpro (&Qunderflow_error);
7497fce1e426 (syms_of_data) [LISP_FLOAT_TYPE]: Define new error conditions:
Richard M. Stallman <rms@gnu.org>
parents: 1987
diff changeset
3193
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3194 staticpro (&Qnil);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3195 staticpro (&Qt);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3196 staticpro (&Qquote);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3197 staticpro (&Qlambda);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3198 staticpro (&Qsubr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3199 staticpro (&Qunbound);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3200 staticpro (&Qerror_conditions);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3201 staticpro (&Qerror_message);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3202 staticpro (&Qtop_level);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3203
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3204 staticpro (&Qerror);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3205 staticpro (&Qquit);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3206 staticpro (&Qwrong_type_argument);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3207 staticpro (&Qargs_out_of_range);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3208 staticpro (&Qvoid_function);
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3209 staticpro (&Qcyclic_function_indirection);
61888
a0e6e458f2fc (syms_of_data) Staticpro Qcyclic_variable_indirection.
Kim F. Storm <storm@cua.dk>
parents: 61686
diff changeset
3210 staticpro (&Qcyclic_variable_indirection);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3211 staticpro (&Qvoid_variable);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3212 staticpro (&Qsetting_constant);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3213 staticpro (&Qinvalid_read_syntax);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3214 staticpro (&Qwrong_number_of_arguments);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3215 staticpro (&Qinvalid_function);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3216 staticpro (&Qno_catch);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3217 staticpro (&Qend_of_file);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3218 staticpro (&Qarith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3219 staticpro (&Qbeginning_of_buffer);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3220 staticpro (&Qend_of_buffer);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3221 staticpro (&Qbuffer_read_only);
26274
e310c2b8e6ed (Qtext_read_only): New built-in error.
Gerd Moellmann <gerd@gnu.org>
parents: 26205
diff changeset
3222 staticpro (&Qtext_read_only);
4037
aecb99c65ab0 (syms_of_data): Staticpro Qmark_inactive.
Roland McGrath <roland@gnu.org>
parents: 4036
diff changeset
3223 staticpro (&Qmark_inactive);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3224
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3225 staticpro (&Qlistp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3226 staticpro (&Qconsp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3227 staticpro (&Qsymbolp);
26931
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
3228 staticpro (&Qkeywordp);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3229 staticpro (&Qintegerp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3230 staticpro (&Qnatnump);
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
3231 staticpro (&Qwholenump);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3232 staticpro (&Qstringp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3233 staticpro (&Qarrayp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3234 staticpro (&Qsequencep);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3235 staticpro (&Qbufferp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3236 staticpro (&Qvectorp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3237 staticpro (&Qchar_or_string_p);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3238 staticpro (&Qmarkerp);
1293
95ae0805ebba Qbuffer_or_string_p added.
Joseph Arceneaux <jla@gnu.org>
parents: 1278
diff changeset
3239 staticpro (&Qbuffer_or_string_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3240 staticpro (&Qinteger_or_marker_p);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3241 staticpro (&Qfloatp);
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
3242 staticpro (&Qnumberp);
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
3243 staticpro (&Qnumber_or_marker_p);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
3244 staticpro (&Qchar_table_p);
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
3245 staticpro (&Qvector_or_char_table_p);
29237
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3246 staticpro (&Qsubrp);
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3247 staticpro (&Qmany);
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3248 staticpro (&Qunevalled);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3249
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3250 staticpro (&Qboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3251 staticpro (&Qfboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3252 staticpro (&Qcdr);
8448
b6335ce87e16 (Fdefine_function, Fdefalias): Handle advice as in Ffset.
Richard M. Stallman <rms@gnu.org>
parents: 8415
diff changeset
3253 staticpro (&Qad_advice_info);
26205
65a0abaeed68 (Qad_activate_internal): Renamed from Qad_activate.
Gerd Moellmann <gerd@gnu.org>
parents: 26185
diff changeset
3254 staticpro (&Qad_activate_internal);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3255
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3256 /* 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
3257 Qinteger = intern ("integer");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3258 Qsymbol = intern ("symbol");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3259 Qstring = intern ("string");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3260 Qcons = intern ("cons");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3261 Qmarker = intern ("marker");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3262 Qoverlay = intern ("overlay");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3263 Qfloat = intern ("float");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3264 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
3265 Qprocess = intern ("process");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3266 Qwindow = intern ("window");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3267 /* Qsubr = intern ("subr"); */
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3268 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
3269 Qbuffer = intern ("buffer");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3270 Qframe = intern ("frame");
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3271 Qvector = intern ("vector");
13715
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
3272 Qchar_table = intern ("char-table");
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
3273 Qbool_vector = intern ("bool-vector");
26185
be223f84693c (Qhash_table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
3274 Qhash_table = intern ("hash-table");
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3275
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3276 staticpro (&Qinteger);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3277 staticpro (&Qsymbol);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3278 staticpro (&Qstring);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3279 staticpro (&Qcons);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3280 staticpro (&Qmarker);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3281 staticpro (&Qoverlay);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3282 staticpro (&Qfloat);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3283 staticpro (&Qwindow_configuration);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3284 staticpro (&Qprocess);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3285 staticpro (&Qwindow);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3286 /* staticpro (&Qsubr); */
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3287 staticpro (&Qcompiled_function);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3288 staticpro (&Qbuffer);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3289 staticpro (&Qframe);
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3290 staticpro (&Qvector);
13715
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
3291 staticpro (&Qchar_table);
89ffc133f813 (Ftype_of): Return `char-table' and `bool-vector' for
Karl Heuer <kwzh@gnu.org>
parents: 13593
diff changeset
3292 staticpro (&Qbool_vector);
26185
be223f84693c (Qhash_table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
3293 staticpro (&Qhash_table);
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3294
39575
f847e069b0f6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE.
Gerd Moellmann <gerd@gnu.org>
parents: 37053
diff changeset
3295 defsubr (&Sindirect_variable);
54627
532e0d3d8fc1 (Finteractive_form): Rename from Fsubr_interactive_form.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53966
diff changeset
3296 defsubr (&Sinteractive_form);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3297 defsubr (&Seq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3298 defsubr (&Snull);
10725
24958130d147 Rename arg OBJ to OBJECT in all type predicates.
Richard M. Stallman <rms@gnu.org>
parents: 10645
diff changeset
3299 defsubr (&Stype_of);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3300 defsubr (&Slistp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3301 defsubr (&Snlistp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3302 defsubr (&Sconsp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3303 defsubr (&Satom);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3304 defsubr (&Sintegerp);
695
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
3305 defsubr (&Sinteger_or_marker_p);
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
3306 defsubr (&Snumberp);
e3fac20d3015 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 648
diff changeset
3307 defsubr (&Snumber_or_marker_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3308 defsubr (&Sfloatp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3309 defsubr (&Snatnump);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3310 defsubr (&Ssymbolp);
26931
234be1721197 (Fkeywordp): New function.
Dave Love <fx@gnu.org>
parents: 26849
diff changeset
3311 defsubr (&Skeywordp);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3312 defsubr (&Sstringp);
20793
b2af60896559 (syms_of_data): Register multibyte-string-p as a Lisp
Kenichi Handa <handa@m17n.org>
parents: 20716
diff changeset
3313 defsubr (&Smultibyte_string_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3314 defsubr (&Svectorp);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
3315 defsubr (&Schar_table_p);
13200
5fd4e8e4185a (Qvector_or_char_table_p): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13148
diff changeset
3316 defsubr (&Svector_or_char_table_p);
13148
18b1b690defe (Fchartablep, Fboolvectorp): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 12528
diff changeset
3317 defsubr (&Sbool_vector_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3318 defsubr (&Sarrayp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3319 defsubr (&Ssequencep);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3320 defsubr (&Sbufferp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3321 defsubr (&Smarkerp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3322 defsubr (&Ssubrp);
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1648
diff changeset
3323 defsubr (&Sbyte_code_function_p);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3324 defsubr (&Schar_or_string_p);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3325 defsubr (&Scar);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3326 defsubr (&Scdr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3327 defsubr (&Scar_safe);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3328 defsubr (&Scdr_safe);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3329 defsubr (&Ssetcar);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3330 defsubr (&Ssetcdr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3331 defsubr (&Ssymbol_function);
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3332 defsubr (&Sindirect_function);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3333 defsubr (&Ssymbol_plist);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3334 defsubr (&Ssymbol_name);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3335 defsubr (&Smakunbound);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3336 defsubr (&Sfmakunbound);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3337 defsubr (&Sboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3338 defsubr (&Sfboundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3339 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
3340 defsubr (&Sdefalias);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3341 defsubr (&Ssetplist);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3342 defsubr (&Ssymbol_value);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3343 defsubr (&Sset);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3344 defsubr (&Sdefault_boundp);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3345 defsubr (&Sdefault_value);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3346 defsubr (&Sset_default);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3347 defsubr (&Ssetq_default);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3348 defsubr (&Smake_variable_buffer_local);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3349 defsubr (&Smake_local_variable);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3350 defsubr (&Skill_local_variable);
21144
6988880cc529 (store_symval_forwarding, swap_in_symval_forwarding)
Richard M. Stallman <rms@gnu.org>
parents: 20996
diff changeset
3351 defsubr (&Smake_variable_frame_local);
9194
3db4151c3d00 (Fmake_local_variable): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9147
diff changeset
3352 defsubr (&Slocal_variable_p);
12295
b4731504d3ab (Flocal_variable_if_set_p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12244
diff changeset
3353 defsubr (&Slocal_variable_if_set_p);
52537
ab6a470dc45f (Fvariable_binding_locus): New function.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
3354 defsubr (&Svariable_binding_locus);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3355 defsubr (&Saref);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3356 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
3357 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
3358 defsubr (&Sstring_to_number);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3359 defsubr (&Seqlsign);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3360 defsubr (&Slss);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3361 defsubr (&Sgtr);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3362 defsubr (&Sleq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3363 defsubr (&Sgeq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3364 defsubr (&Sneq);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3365 defsubr (&Szerop);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3366 defsubr (&Splus);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3367 defsubr (&Sminus);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3368 defsubr (&Stimes);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3369 defsubr (&Squo);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3370 defsubr (&Srem);
4508
763987892042 (Fmod): New function; result is always same sign as divisor.
Paul Eggert <eggert@twinsun.com>
parents: 4447
diff changeset
3371 defsubr (&Smod);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3372 defsubr (&Smax);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3373 defsubr (&Smin);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3374 defsubr (&Slogand);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3375 defsubr (&Slogior);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3376 defsubr (&Slogxor);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3377 defsubr (&Slsh);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3378 defsubr (&Sash);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3379 defsubr (&Sadd1);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3380 defsubr (&Ssub1);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3381 defsubr (&Slognot);
53910
9c480a55fc22 * data.c (Fbyteorder): New function.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53365
diff changeset
3382 defsubr (&Sbyteorder);
29237
ae0e64edbaad (Qsubrp, Qmany, Qunevalled): New variables.
Dave Love <fx@gnu.org>
parents: 29007
diff changeset
3383 defsubr (&Ssubr_arity);
55230
c41874c7d876 (Fsubr_name): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55160
diff changeset
3384 defsubr (&Ssubr_name);
6459
30fabcc03f0c (Qwholenump): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 6448
diff changeset
3385
9954
18b408b05189 (syms_of_data): Set Qwholenump as function, not variable.
Karl Heuer <kwzh@gnu.org>
parents: 9895
diff changeset
3386 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
39632
8cd74f2aa6e2 (most_positive_fixnum, most_negative_fixnum): New
Gerd Moellmann <gerd@gnu.org>
parents: 39575
diff changeset
3387
41865
f5dbdfc9fe27 (Vmost_positive_fixnum, Vmost_negative_fixnum): Renamed
Andreas Schwab <schwab@suse.de>
parents: 41153
diff changeset
3388 DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum,
f5dbdfc9fe27 (Vmost_positive_fixnum, Vmost_negative_fixnum): Renamed
Andreas Schwab <schwab@suse.de>
parents: 41153
diff changeset
3389 doc: /* The largest value that is representable in a Lisp integer. */);
f5dbdfc9fe27 (Vmost_positive_fixnum, Vmost_negative_fixnum): Renamed
Andreas Schwab <schwab@suse.de>
parents: 41153
diff changeset
3390 Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
48961
39ba2cdf869e (Fmakunbound, Ffmakunbound, Fmake_variable_buffer_local)
Francesco Potortì <pot@gnu.org>
parents: 48723
diff changeset
3391
41865
f5dbdfc9fe27 (Vmost_positive_fixnum, Vmost_negative_fixnum): Renamed
Andreas Schwab <schwab@suse.de>
parents: 41153
diff changeset
3392 DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum,
f5dbdfc9fe27 (Vmost_positive_fixnum, Vmost_negative_fixnum): Renamed
Andreas Schwab <schwab@suse.de>
parents: 41153
diff changeset
3393 doc: /* The smallest value that is representable in a Lisp integer. */);
f5dbdfc9fe27 (Vmost_positive_fixnum, Vmost_negative_fixnum): Renamed
Andreas Schwab <schwab@suse.de>
parents: 41153
diff changeset
3394 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3395 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3396
490
a54a07015253 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 348
diff changeset
3397 SIGTYPE
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3398 arith_error (signo)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3399 int signo;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3400 {
16150
f388360fb59a (arith_error) [POSIX_SIGNALS]: Don't reestablish handler.
Richard M. Stallman <rms@gnu.org>
parents: 16051
diff changeset
3401 #if defined(USG) && !defined(POSIX_SIGNALS)
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3402 /* USG systems forget handlers when they are used;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3403 must reestablish each time */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3404 signal (signo, arith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3405 #endif /* USG */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3406 #ifdef VMS
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3407 /* VMS systems are like USG. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3408 signal (signo, arith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3409 #endif /* VMS */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3410 #ifdef BSD4_1
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3411 sigrelse (SIGFPE);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3412 #else /* not BSD4_1 */
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
3413 sigsetmask (SIGEMPTYMASK);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3414 #endif /* not BSD4_1 */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3415
58986
59945307b86b * syssignal.h: Declare main_thread.
Jan Djärv <jan.h.d@swipnet.se>
parents: 58733
diff changeset
3416 SIGNAL_THREAD_CHECK (signo);
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3417 Fsignal (Qarith_error, Qnil);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3418 }
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3419
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21476
diff changeset
3420 void
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3421 init_data ()
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3422 {
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3423 /* Don't do this if just dumping out.
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3424 We don't want to call `signal' in this case
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3425 so that we don't have trouble with dumping
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3426 signal-delivering routines in an inconsistent state. */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3427 #ifndef CANNOT_DUMP
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3428 if (!initialized)
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3429 return;
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3430 #endif /* CANNOT_DUMP */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3431 signal (SIGFPE, arith_error);
10605
bc37b55fcbb9 (do_symval_forwarding): Handle display-local vars.
Karl Heuer <kwzh@gnu.org>
parents: 10457
diff changeset
3432
298
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3433 #ifdef uts
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3434 signal (SIGEMT, arith_error);
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3435 #endif /* uts */
a9d3e8df1eec Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3436 }
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52376
diff changeset
3437
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52376
diff changeset
3438 /* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52376
diff changeset
3439 (do not change this comment) */