annotate src/fns.c @ 9006:186aff8c1f51

(evaporate_overlays): Overlay is in car, not cdr.
author Karl Heuer <kwzh@gnu.org>
date Thu, 22 Sep 1994 19:20:52 +0000
parents cafc16f356c2
children 04a702d7f662
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* Random utility Lisp functions.
7307
cd81dba38a49 Update copyright.
Karl Heuer <kwzh@gnu.org>
parents: 6990
diff changeset
2 Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 This file is part of GNU Emacs.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 the Free Software Foundation; either version 1, or (at your option)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 any later version.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU General Public License for more details.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 along with GNU Emacs; see the file COPYING. If not, write to
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4616
diff changeset
21 #include <config.h>
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23 /* Note on some machines this defines `vector' as a typedef,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 so make sure we don't use that name in this file. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
25 #undef vector
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26 #define vector *****
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
27
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28 #include "lisp.h"
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 #include "commands.h"
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 #include "buffer.h"
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
32 #include "keyboard.h"
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
33 #include "intervals.h"
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34
8901
ab65a3dae221 (Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents: 8388
diff changeset
35 extern Lisp_Object Flookup_key ();
ab65a3dae221 (Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents: 8388
diff changeset
36
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
37 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
38 Lisp_Object Qyes_or_no_p_history;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
39
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
40 static Lisp_Object internal_equal ();
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
41
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
42 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 "Return the argument unchanged.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
47 return arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
48 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
49
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
51 "Return a pseudo-random number.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
52 On most systems all integers representable in Lisp are equally likely.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
53 This is 24 bits' worth.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
54 With argument N, return random number in interval [0,N).\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
55 With argument t, set the random number seed from the current time and pid.")
1743
a1933e20a2a3 (Frandom): Change arg name.
Richard M. Stallman <rms@gnu.org>
parents: 1513
diff changeset
56 (limit)
a1933e20a2a3 (Frandom): Change arg name.
Richard M. Stallman <rms@gnu.org>
parents: 1513
diff changeset
57 Lisp_Object limit;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59 int val;
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
60 unsigned long denominator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61 extern long random ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62 extern srandom ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
63 extern long time ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
64
1743
a1933e20a2a3 (Frandom): Change arg name.
Richard M. Stallman <rms@gnu.org>
parents: 1513
diff changeset
65 if (EQ (limit, Qt))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
66 srandom (getpid () + time (0));
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
67 if (XTYPE (limit) == Lisp_Int && XINT (limit) > 0)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
68 {
8901
ab65a3dae221 (Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents: 8388
diff changeset
69 if (XFASTINT (limit) >= 0x40000000)
8388
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
70 /* This case may occur on 64-bit machines. */
8901
ab65a3dae221 (Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents: 8388
diff changeset
71 val = random () % XFASTINT (limit);
8388
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
72 else
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
73 {
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
74 /* Try to take our random number from the higher bits of VAL,
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
75 not the lower, since (says Gentzel) the low bits of `random'
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
76 are less random than the higher ones. We do this by using the
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
77 quotient rather than the remainder. At the high end of the RNG
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
78 it's possible to get a quotient larger than limit; discarding
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
79 these values eliminates the bias that would otherwise appear
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
80 when using a large limit. */
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
81 denominator = (unsigned long)0x40000000 / XFASTINT (limit);
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
82 do
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
83 val = (random () & 0x3fffffff) / denominator;
8901
ab65a3dae221 (Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents: 8388
diff changeset
84 while (val >= XFASTINT (limit));
8388
e0c0247dca19 (Frandom): Handle LIMIT >= 40000000.
Richard M. Stallman <rms@gnu.org>
parents: 8367
diff changeset
85 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 }
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
87 else
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
88 val = random ();
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 return make_number (val);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 /* Random data-structure functions */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 DEFUN ("length", Flength, Slength, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 "Return the length of vector, list or string SEQUENCE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96 A byte-code function object is also allowed.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 (obj)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 register Lisp_Object obj;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100 register Lisp_Object tail, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
101 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
102
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 retry:
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104 if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 || XTYPE (obj) == Lisp_Compiled)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
106 return Farray_length (obj);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107 else if (CONSP (obj))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
109 for (i = 0, tail = obj; !NILP(tail); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 tail = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 XFASTINT (val) = i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
118 else if (NILP(obj))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 XFASTINT (val) = 0;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125 obj = wrong_type_argument (Qsequencep, obj);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131 "T if two strings have identical contents.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 Case is significant.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
133 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
134 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137 if (XTYPE (s1) == Lisp_Symbol)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138 XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 if (XTYPE (s2) == Lisp_Symbol)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
143
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
144 if (XSTRING (s1)->size != XSTRING (s2)->size ||
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 "T if first arg string is less than second in lexicographic order.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152 Case is significant.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
155 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
157 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 register unsigned char *p1, *p2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159 register int end;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 if (XTYPE (s1) == Lisp_Symbol)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162 XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163 if (XTYPE (s2) == Lisp_Symbol)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
164 XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 p1 = XSTRING (s1)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
169 p2 = XSTRING (s2)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 end = XSTRING (s1)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 if (end > XSTRING (s2)->size)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 end = XSTRING (s2)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 for (i = 0; i < end; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 if (p1[i] != p2[i])
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177 return p1[i] < p2[i] ? Qt : Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
179 return i < XSTRING (s2)->size ? Qt : Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
181
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 static Lisp_Object concat ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186 concat2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
188 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
190 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
191 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
192 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 return concat (2, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 return concat (2, &s1, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
196 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198
8966
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
199 /* ARGSUSED */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
200 Lisp_Object
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
201 concat3 (s1, s2, s3)
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
202 Lisp_Object s1, s2, s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
203 {
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
204 #ifdef NO_ARG_ARRAY
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
205 Lisp_Object args[3];
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
206 args[0] = s1;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
207 args[1] = s2;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
208 args[2] = s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
209 return concat (3, args, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
210 #else
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
211 return concat (3, &s1, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
212 #endif /* NO_ARG_ARRAY */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
213 }
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
214
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 "Concatenate all the arguments and make the result a list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217 The result is a list whose elements are the elements of all the arguments.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
218 Each argument may be a list, vector or string.\n\
1037
c17a6750293c (Fappend): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 866
diff changeset
219 The last argument is not copied, just used as the tail of the new list.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224 return concat (nargs, args, Lisp_Cons, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
225 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 "Concatenate all the arguments and make the result a string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 The result is a string whose elements are the elements of all the arguments.\n\
5664
e94f93aef529 (Fconcat): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5661
diff changeset
230 Each argument may be a string, a list of characters (integers),\n\
e94f93aef529 (Fconcat): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5661
diff changeset
231 or a vector of characters (integers).")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
235 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236 return concat (nargs, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
238
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
239 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
240 "Concatenate all the arguments and make the result a vector.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
241 The result is a vector whose elements are the elements of all the arguments.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
242 Each argument may be a list, vector or string.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
243 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
244 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
245 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
246 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
247 return concat (nargs, args, Lisp_Vector, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
248 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
249
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
250 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
251 "Return a copy of a list, vector or string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
252 The elements of a list or vector are not copied; they are shared\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
253 with the original.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
254 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
255 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
256 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
257 if (NILP (arg)) return arg;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
258 if (!CONSP (arg) && XTYPE (arg) != Lisp_Vector && XTYPE (arg) != Lisp_String)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
259 arg = wrong_type_argument (Qsequencep, arg);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
260 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
261 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
262
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
263 static Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
264 concat (nargs, args, target_type, last_special)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
265 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
266 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
267 enum Lisp_Type target_type;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
268 int last_special;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
269 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
270 Lisp_Object val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
271 Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
272 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
273 register Lisp_Object this;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
274 int toindex;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
275 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
276 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
277 Lisp_Object last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
278 Lisp_Object prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 /* In append, the last arg isn't treated like the others */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 if (last_special && nargs > 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
283 nargs--;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
284 last_tail = args[nargs];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287 last_tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 this = args[argnum];
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
292 if (!(CONSP (this) || NILP (this)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
293 || XTYPE (this) == Lisp_Vector || XTYPE (this) == Lisp_String
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 || XTYPE (this) == Lisp_Compiled))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
296 if (XTYPE (this) == Lisp_Int)
2429
96b55f2f19cd Rename int-to-string to number-to-string, since it can handle
Jim Blandy <jimb@redhat.com>
parents: 2369
diff changeset
297 args[argnum] = Fnumber_to_string (this);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
298 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
299 args[argnum] = wrong_type_argument (Qsequencep, this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
300 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303 for (argnum = 0, leni = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
304 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
305 this = args[argnum];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
306 len = Flength (this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
307 leni += XFASTINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
308 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
309
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 XFASTINT (len) = leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 if (target_type == Lisp_Cons)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313 val = Fmake_list (len, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 else if (target_type == Lisp_Vector)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
315 val = Fmake_vector (len, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
316 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
317 val = Fmake_string (len, len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
318
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
319 /* In append, if all but last arg are nil, return last arg */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
320 if (target_type == Lisp_Cons && EQ (val, Qnil))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
321 return last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
322
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
323 if (CONSP (val))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
324 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
325 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
326 toindex = 0;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
327
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
328 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
329
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
330 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
331 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
332 Lisp_Object thislen;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
333 int thisleni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334 register int thisindex = 0;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
335
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
336 this = args[argnum];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
337 if (!CONSP (this))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
338 thislen = Flength (this), thisleni = XINT (thislen);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
339
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
340 if (XTYPE (this) == Lisp_String && XTYPE (val) == Lisp_String
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
341 && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
342 {
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
343 copy_text_properties (make_number (0), thislen, this,
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
344 make_number (toindex), val, Qnil);
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
345 }
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
346
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
347 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
348 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
349 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
350
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
351 /* Fetch next element of `this' arg into `elt', or break if
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
352 `this' is exhausted. */
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
353 if (NILP (this)) break;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
354 if (CONSP (this))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 elt = Fcar (this), this = Fcdr (this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
356 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 if (thisindex >= thisleni) break;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
359 if (XTYPE (this) == Lisp_String)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
360 XFASTINT (elt) = XSTRING (this)->data[thisindex++];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
361 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 elt = XVECTOR (this)->contents[thisindex++];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365 /* Store into result */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
366 if (toindex < 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 XCONS (tail)->car = elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
369 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 tail = XCONS (tail)->cdr;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 else if (XTYPE (val) == Lisp_Vector)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373 XVECTOR (val)->contents[toindex++] = elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
375 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
376 while (XTYPE (elt) != Lisp_Int)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 elt = wrong_type_argument (Qintegerp, elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
378 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 #ifdef MASSC_REGISTER_BUG
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 /* Even removing all "register"s doesn't disable this bug!
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 Nothing simpler than this seems to work. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 unsigned char *p = & XSTRING (val)->data[toindex++];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383 *p = XINT (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385 XSTRING (val)->data[toindex++] = XINT (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 #endif
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
391 if (!NILP (prev))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392 XCONS (prev)->cdr = last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
394 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
395 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 "Return a copy of ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 This is an alist which represents the same mapping from objects to objects,\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 but does not share the alist structure with ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 The objects mapped (cars and cdrs of elements of the alist)\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402 are shared, however.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
403 Elements of ALIST that are not conses are also shared.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
404 (alist)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
405 Lisp_Object alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 CHECK_LIST (alist, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
410 if (NILP (alist))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 alist = concat (1, &alist, Lisp_Cons, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413 for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
414 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 register Lisp_Object car;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
416 car = XCONS (tem)->car;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 if (CONSP (car))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
423
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
425 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 If FROM or TO is negative, it counts from the end.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 (string, from, to)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 Lisp_Object string;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 register Lisp_Object from, to;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 {
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
432 Lisp_Object res;
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
433
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434 CHECK_STRING (string, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 CHECK_NUMBER (from, 1);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
436 if (NILP (to))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 to = Flength (string);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
439 CHECK_NUMBER (to, 2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 if (XINT (from) < 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 XSETINT (from, XINT (from) + XSTRING (string)->size);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443 if (XINT (to) < 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
444 XSETINT (to, XINT (to) + XSTRING (string)->size);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
445 if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
446 && XINT (to) <= XSTRING (string)->size))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
447 args_out_of_range_3 (string, from, to);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
448
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
449 res = make_string (XSTRING (string)->data + XINT (from),
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
450 XINT (to) - XINT (from));
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
451 copy_text_properties (from, to, string, make_number (0), res, Qnil);
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
452 return res;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
455 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456 "Take cdr N times on LIST, returns the result.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458 Lisp_Object n;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
459 register Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
460 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
461 register int i, num;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
462 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 num = XINT (n);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
464 for (i = 0; i < num && !NILP (list); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
465 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
466 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
467 list = Fcdr (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
468 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
469 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
470 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
471
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
473 "Return the Nth element of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
474 N counts from zero. If LIST is not that long, nil is returned.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
475 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476 Lisp_Object n, list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478 return Fcar (Fnthcdr (n, list));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 DEFUN ("elt", Felt, Selt, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 "Return element of SEQUENCE at index N.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 (seq, n)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 register Lisp_Object seq, n;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
488 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
489 if (XTYPE (seq) == Lisp_Cons || NILP (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490 return Fcar (Fnthcdr (n, seq));
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
491 else if (XTYPE (seq) == Lisp_String
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
492 || XTYPE (seq) == Lisp_Vector)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493 return Faref (seq, n);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495 seq = wrong_type_argument (Qsequencep, seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
497 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
498
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
499 DEFUN ("member", Fmember, Smember, 2, 2, 0,
6990
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
500 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
501 The value is actually the tail of LIST whose car is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
502 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
503 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
504 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
505 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
506 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
507 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
508 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
509 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 tem = Fcar (tail);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
511 if (! NILP (Fequal (elt, tem)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
514 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
515 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 The value is actually the tail of LIST whose car is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
526 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 if (EQ (elt, tem)) return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
531 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
532 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
533 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
535
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
537 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
538 The value is actually the element of LIST whose car is KEY.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539 Elements of LIST that are not conses are ignored.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
540 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
541 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
542 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
543 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
545 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
547 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
548 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
549 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550 tem = Fcar (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
551 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
552 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
553 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
555 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
556
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 /* Like Fassq but never report an error and do not allow quits.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 Use only on lists known never to be circular. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561 assq_no_quit (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 for (tail = list; CONSP (tail); tail = Fcdr (tail))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
571 tem = Fcar (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
572 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
576
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
577 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
578 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
579 The value is actually the element of LIST whose car is KEY.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
580 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
581 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
582 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
583 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
584 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
585 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
586 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
587 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
588 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 tem = Fequal (Fcar (elt), key);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
591 if (!NILP (tem)) return elt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
597 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
598 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
599 The value is actually the element of LIST whose cdr is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
601 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
602 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
604 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
605 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
606 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
607 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
608 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
609 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
610 tem = Fcdr (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
611 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
612 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
613 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
614 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
615 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
616
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
617 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
618 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
619 The modified LIST is returned. Comparison is done with `eq'.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
620 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
621 therefore, write `(setq foo (delq element foo))'\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
622 to be sure of changing the value of `foo'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
623 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
624 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
625 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
626 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
627 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
628 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
629
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
630 tail = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
631 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
632 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
633 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
634 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
635 if (EQ (elt, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
636 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
637 if (NILP (prev))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
638 list = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
639 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
640 Fsetcdr (prev, Fcdr (tail));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
641 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
642 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
643 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
644 tail = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
645 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
646 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
647 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
648 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
649
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
650 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
651 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
652 The modified LIST is returned. Comparison is done with `equal'.\n\
6990
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
653 If the first member of LIST is ELT, deleting it is not a side effect;\n\
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
654 it is simply using a different list.\n\
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
655 Therefore, write `(setq foo (delete element foo))'\n\
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
656 to be sure of changing the value of `foo'.")
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
657 (elt, list)
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
658 register Lisp_Object elt;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
659 Lisp_Object list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
660 {
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
661 register Lisp_Object tail, prev;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
662 register Lisp_Object tem;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
663
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
664 tail = list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
665 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
666 while (!NILP (tail))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
667 {
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
668 tem = Fcar (tail);
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
669 if (! NILP (Fequal (elt, tem)))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
670 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
671 if (NILP (prev))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
672 list = Fcdr (tail);
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
673 else
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
674 Fsetcdr (prev, Fcdr (tail));
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
675 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
676 else
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
677 prev = tail;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
678 tail = Fcdr (tail);
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
679 QUIT;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
680 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
681 return list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
682 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
683
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
684 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
685 "Reverse LIST by modifying cdr pointers.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
686 Returns the beginning of the reversed list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
687 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
688 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
689 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
690 register Lisp_Object prev, tail, next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
691
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
692 if (NILP (list)) return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
693 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
694 tail = list;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
695 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
696 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
698 next = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
699 Fsetcdr (tail, prev);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
700 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
701 tail = next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
702 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703 return prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
705
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
706 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
707 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
708 See also the function `nreverse', which is used more often.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
709 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
710 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
711 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
712 Lisp_Object length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
713 register Lisp_Object *vec;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
714 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
715 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
716
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
717 length = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
718 vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
719 for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
720 vec[i] = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
721
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
722 return Flist (XINT (length), vec);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
723 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
725 Lisp_Object merge ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
726
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
727 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
728 "Sort LIST, stably, comparing elements using PREDICATE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
729 Returns the sorted list. LIST is modified by side effects.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
730 PREDICATE is called with two elements of LIST, and should return T\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
731 if the first element is \"less\" than the second.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
732 (list, pred)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
733 Lisp_Object list, pred;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
734 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
735 Lisp_Object front, back;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
736 register Lisp_Object len, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
737 struct gcpro gcpro1, gcpro2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
738 register int length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
739
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
740 front = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
741 len = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
742 length = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
743 if (length < 2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
744 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
745
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
746 XSETINT (len, (length / 2) - 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
747 tem = Fnthcdr (len, list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
748 back = Fcdr (tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
749 Fsetcdr (tem, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
750
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
751 GCPRO2 (front, back);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
752 front = Fsort (front, pred);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
753 back = Fsort (back, pred);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
754 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
755 return merge (front, back, pred);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
756 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
757
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
758 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
759 merge (org_l1, org_l2, pred)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
760 Lisp_Object org_l1, org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
761 Lisp_Object pred;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
762 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
763 Lisp_Object value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
764 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
765 Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
766 register Lisp_Object l1, l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
767 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
768
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
769 l1 = org_l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
770 l2 = org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
771 tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
772 value = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
773
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
774 /* It is sufficient to protect org_l1 and org_l2.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
775 When l1 and l2 are updated, we copy the new values
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
776 back into the org_ vars. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
777 GCPRO4 (org_l1, org_l2, pred, value);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
778
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
779 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
780 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
781 if (NILP (l1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
782 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
783 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
784 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
785 return l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
786 Fsetcdr (tail, l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
787 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
788 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
789 if (NILP (l2))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
790 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
791 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
792 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
793 return l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
794 Fsetcdr (tail, l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
795 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
796 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
797 tem = call2 (pred, Fcar (l2), Fcar (l1));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
798 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
799 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
800 tem = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
801 l1 = Fcdr (l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
802 org_l1 = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
803 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
804 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
805 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
806 tem = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
807 l2 = Fcdr (l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
808 org_l2 = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
809 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
810 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
811 value = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
812 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
813 Fsetcdr (tail, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
814 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
815 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
816 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
817
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
818 DEFUN ("get", Fget, Sget, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
819 "Return the value of SYMBOL's PROPNAME property.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
820 This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
821 (sym, prop)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
822 Lisp_Object sym;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
823 register Lisp_Object prop;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
824 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
825 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
826 for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
827 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
828 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
829 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
830 if (EQ (prop, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
831 return Fcar (Fcdr (tail));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
832 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
833 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
834 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
835
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
836 DEFUN ("put", Fput, Sput, 3, 3, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
837 "Store SYMBOL's PROPNAME property with value VALUE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
838 It can be retrieved with `(get SYMBOL PROPNAME)'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
839 (sym, prop, val)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
840 Lisp_Object sym;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
841 register Lisp_Object prop;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
842 Lisp_Object val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
843 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
844 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
845 Lisp_Object newcell;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
846 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
847 for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
848 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
849 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
850 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
851 if (EQ (prop, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
852 return Fsetcar (Fcdr (tail), val);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
853 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
854 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
855 newcell = Fcons (prop, Fcons (val, Qnil));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
856 if (NILP (prev))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
857 Fsetplist (sym, newcell);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
858 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
859 Fsetcdr (Fcdr (prev), newcell);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
860 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
861 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
862
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
863 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
864 "T if two Lisp objects have similar structure and contents.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
865 They must have the same data type.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
866 Conses are compared by comparing the cars and the cdrs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
867 Vectors and strings are compared element by element.\n\
3379
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
868 Numbers are compared by value, but integers cannot equal floats.\n\
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
869 (Use `=' if you want integers and floats to be able to be equal.)\n\
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
870 Symbols must match exactly.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
871 (o1, o2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
872 register Lisp_Object o1, o2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
873 {
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
874 return internal_equal (o1, o2, 0);
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
875 }
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
876
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
877 static Lisp_Object
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
878 internal_equal (o1, o2, depth)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
879 register Lisp_Object o1, o2;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
880 int depth;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
881 {
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
882 if (depth > 200)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
883 error ("Stack overflow in equal");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
884 do_cdr:
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
885 QUIT;
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1743
diff changeset
886 if (EQ (o1, o2)) return Qt;
1822
001382595e48 * fns.c (internal_equal): Protect the clause for comparing numbers
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
887 #ifdef LISP_FLOAT_TYPE
3379
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
888 if (FLOATP (o1) && FLOATP (o2))
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
889 return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
1822
001382595e48 * fns.c (internal_equal): Protect the clause for comparing numbers
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
890 #endif
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
891 if (XTYPE (o1) != XTYPE (o2)) return Qnil;
2782
683f4472f1c8 * lisp.h (Lisp_Overlay): New tag.
Jim Blandy <jimb@redhat.com>
parents: 2654
diff changeset
892 if (XTYPE (o1) == Lisp_Cons
683f4472f1c8 * lisp.h (Lisp_Overlay): New tag.
Jim Blandy <jimb@redhat.com>
parents: 2654
diff changeset
893 || XTYPE (o1) == Lisp_Overlay)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
894 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
895 Lisp_Object v1;
1919
51be204d02a0 * fns.c (Fequal): Call internal_equal to recurse on elements of
Jim Blandy <jimb@redhat.com>
parents: 1822
diff changeset
896 v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
897 if (NILP (v1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
898 return v1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
899 o1 = Fcdr (o1), o2 = Fcdr (o2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
900 goto do_cdr;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
901 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
902 if (XTYPE (o1) == Lisp_Marker)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
903 {
4613
eb2af4aa80e4 (internal_equal): All markers in no buffer are equal.
Richard M. Stallman <rms@gnu.org>
parents: 4456
diff changeset
904 return ((XMARKER (o1)->buffer == XMARKER (o2)->buffer
4616
f2f13eeb1c2e (internal_equal): Typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents: 4613
diff changeset
905 && (XMARKER (o1)->buffer == 0
4613
eb2af4aa80e4 (internal_equal): All markers in no buffer are equal.
Richard M. Stallman <rms@gnu.org>
parents: 4456
diff changeset
906 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos))
eb2af4aa80e4 (internal_equal): All markers in no buffer are equal.
Richard M. Stallman <rms@gnu.org>
parents: 4456
diff changeset
907 ? Qt : Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
908 }
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1743
diff changeset
909 if (XTYPE (o1) == Lisp_Vector
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1743
diff changeset
910 || XTYPE (o1) == Lisp_Compiled)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
911 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
912 register int index;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
913 if (XVECTOR (o1)->size != XVECTOR (o2)->size)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
914 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
915 for (index = 0; index < XVECTOR (o1)->size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
916 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
917 Lisp_Object v, v1, v2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
918 v1 = XVECTOR (o1)->contents [index];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
919 v2 = XVECTOR (o2)->contents [index];
1919
51be204d02a0 * fns.c (Fequal): Call internal_equal to recurse on elements of
Jim Blandy <jimb@redhat.com>
parents: 1822
diff changeset
920 v = internal_equal (v1, v2, depth + 1);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
921 if (NILP (v)) return v;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
922 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
923 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
924 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
925 if (XTYPE (o1) == Lisp_String)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
926 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
927 if (XSTRING (o1)->size != XSTRING (o2)->size)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
928 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
929 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
930 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
931 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
932 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
933 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
934 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
935
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
936 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
937 "Store each element of ARRAY with ITEM. ARRAY is a vector or string.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
938 (array, item)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
939 Lisp_Object array, item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
940 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
941 register int size, index, charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
942 retry:
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
943 if (XTYPE (array) == Lisp_Vector)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
944 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
945 register Lisp_Object *p = XVECTOR (array)->contents;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
946 size = XVECTOR (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
947 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
948 p[index] = item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
949 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
950 else if (XTYPE (array) == Lisp_String)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
951 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
952 register unsigned char *p = XSTRING (array)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
953 CHECK_NUMBER (item, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
954 charval = XINT (item);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
955 size = XSTRING (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
956 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
957 p[index] = charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
958 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
959 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
960 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
961 array = wrong_type_argument (Qarrayp, array);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
962 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
963 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
964 return array;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
965 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
966
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
967 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
968 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
969 nconc2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
970 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
971 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
972 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
973 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
974 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
975 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
976 return Fnconc (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
977 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
978 return Fnconc (2, &s1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
979 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
980 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
981
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
982 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
983 "Concatenate any number of lists by altering them.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
984 Only the last argument is not altered, and need not be a list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
985 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
986 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
987 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
988 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
989 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
990 register Lisp_Object tail, tem, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
991
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
992 val = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
993
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
994 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
995 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
996 tem = args[argnum];
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
997 if (NILP (tem)) continue;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
998
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
999 if (NILP (val))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1000 val = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1001
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1002 if (argnum + 1 == nargs) break;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1003
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1004 if (!CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1005 tem = wrong_type_argument (Qlistp, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1006
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1007 while (CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1008 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1009 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1010 tem = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1011 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1012 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1013
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1014 tem = args[argnum + 1];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1015 Fsetcdr (tail, tem);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1016 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1017 args[argnum + 1] = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1018 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1019
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1020 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1021 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1022
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1023 /* This is the guts of all mapping functions.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1024 Apply fn to each element of seq, one by one,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1025 storing the results into elements of vals, a C vector of Lisp_Objects.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1026 leni is the length of vals, which should also be the length of seq. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1027
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1028 static void
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1029 mapcar1 (leni, vals, fn, seq)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1030 int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1031 Lisp_Object *vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1032 Lisp_Object fn, seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1033 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1034 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1035 Lisp_Object dummy;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1036 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1037 struct gcpro gcpro1, gcpro2, gcpro3;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1038
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1039 /* Don't let vals contain any garbage when GC happens. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1040 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1041 vals[i] = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1042
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1043 GCPRO3 (dummy, fn, seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1044 gcpro1.var = vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1045 gcpro1.nvars = leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1046 /* We need not explicitly protect `tail' because it is used only on lists, and
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1047 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1048
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1049 if (XTYPE (seq) == Lisp_Vector)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1050 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1051 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1052 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1053 dummy = XVECTOR (seq)->contents[i];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1054 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1055 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1056 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 else if (XTYPE (seq) == Lisp_String)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1058 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1059 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1060 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1061 XFASTINT (dummy) = XSTRING (seq)->data[i];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1062 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1063 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1064 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1065 else /* Must be a list, since Flength did not get an error */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1066 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1067 tail = seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1068 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1069 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1070 vals[i] = call1 (fn, Fcar (tail));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1071 tail = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1072 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1073 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1074
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1075 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1076 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1077
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1078 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1079 "Apply FN to each element of SEQ, and concat the results as strings.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1080 In between each pair of results, stick in SEP.\n\
5437
7a9ff03ecccf (Fmapconcat): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 4696
diff changeset
1081 Thus, \" \" as SEP results in spaces between the values returned by FN.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1082 (fn, seq, sep)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1083 Lisp_Object fn, seq, sep;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1084 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1085 Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1086 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1087 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1088 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1089 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1090 struct gcpro gcpro1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1091
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1092 len = Flength (seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1093 leni = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1094 nargs = leni + leni - 1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1095 if (nargs < 0) return build_string ("");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1096
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1097 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1098
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1099 GCPRO1 (sep);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1100 mapcar1 (leni, args, fn, seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1101 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1102
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1103 for (i = leni - 1; i >= 0; i--)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1104 args[i + i] = args[i];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1105
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1106 for (i = 1; i < nargs; i += 2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1107 args[i] = sep;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1108
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1109 return Fconcat (nargs, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1110 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1111
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1112 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1113 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1114 The result is a list just as long as SEQUENCE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1115 SEQUENCE may be a list, a vector or a string.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1116 (fn, seq)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1117 Lisp_Object fn, seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1118 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1119 register Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1120 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1121 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1122
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1123 len = Flength (seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1124 leni = XFASTINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1125 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1126
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1127 mapcar1 (leni, args, fn, seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1128
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1129 return Flist (leni, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1130 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1131
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1132 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1133
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1134 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1135 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
759
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
1136 Takes one argument, which is the string to display to ask the question.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
1137 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1138 No confirmation of the answer is requested; a single character is enough.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1139 Also accepts Space to mean yes, or Delete to mean no.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1140 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1141 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1142 {
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1143 register Lisp_Object obj, key, def, answer_string, map;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1144 register int answer;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1145 Lisp_Object xprompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1146 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1147 int ocech = cursor_in_echo_area;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1148 struct gcpro gcpro1, gcpro2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1149
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1150 map = Fsymbol_value (intern ("query-replace-map"));
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1151
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1152 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1153 xprompt = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1154 GCPRO2 (prompt, xprompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1155
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1156 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1157 {
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1158 #ifdef HAVE_X_MENU
7790
75153e2d5d85 (Fy_or_n_p): Don't use dialog box if not an X frame.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
1159 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
75153e2d5d85 (Fy_or_n_p): Don't use dialog box if not an X frame.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
1160 && using_x_p ())
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1161 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1162 Lisp_Object pane, menu;
7815
5d167db8ce8a (Fy_or_n_p, Fyes_or_no_p) [HAVE_X_MENU]: Redisplay before popping up a menu.
Karl Heuer <kwzh@gnu.org>
parents: 7790
diff changeset
1163 redisplay_preserve_echo_area ();
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1164 pane = Fcons (Fcons (build_string ("Yes"), Qt),
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1165 Fcons (Fcons (build_string ("No"), Qnil),
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1166 Qnil));
6478
65c2e184b5d9 (Fy_or_n_p, Fyes_or_no_p): Call Fx_popup_dialog the new way.
Richard M. Stallman <rms@gnu.org>
parents: 6427
diff changeset
1167 menu = Fcons (prompt, pane);
6303
1571be153f56 (Fyes_or_no_p): Call Fx_popup_dialog instead of Fx_popup_menu.
Fred Pierresteguy <F.Pierresteguy@frcl.bull.fr>
parents: 6057
diff changeset
1168 obj = Fx_popup_dialog (Qt, menu);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1169 answer = !NILP (obj);
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1170 break;
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1171 }
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1172 #endif
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1173 cursor_in_echo_area = 1;
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1174 message ("%s(y or n) ", XSTRING (xprompt)->data);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1175
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1176 obj = read_filtered_event (1, 0, 0);
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1177 cursor_in_echo_area = 0;
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1178 /* If we need to quit, quit with cursor_in_echo_area = 0. */
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1179 QUIT;
2369
8ce8541f393a (Fy_or_n_p): Ensure cursor_in_echo_area = 0 when quit.
Richard M. Stallman <rms@gnu.org>
parents: 2311
diff changeset
1180
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1181 key = Fmake_vector (make_number (1), obj);
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1182 def = Flookup_key (map, key);
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1183 answer_string = Fsingle_key_description (obj);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1184
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1185 if (EQ (def, intern ("skip")))
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1186 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1187 answer = 0;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1188 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1189 }
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1190 else if (EQ (def, intern ("act")))
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1191 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1192 answer = 1;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1193 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1194 }
2311
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1195 else if (EQ (def, intern ("recenter")))
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1196 {
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1197 Frecenter (Qnil);
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1198 xprompt = prompt;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1199 continue;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1200 }
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1201 else if (EQ (def, intern ("quit")))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1202 Vquit_flag = Qt;
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1203
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1204 QUIT;
1194
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
1205
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
1206 /* If we don't clear this, then the next call to read_char will
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
1207 return quit_char again, and we'll enter an infinite loop. */
1193
e1329d41271d * fns.c (Fy_or_n_p): After testing for a QUIT, clear Vquit_flag.
Jim Blandy <jimb@redhat.com>
parents: 1093
diff changeset
1208 Vquit_flag = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1209
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1210 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1212 if (EQ (xprompt, prompt))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1213 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1214 args[0] = build_string ("Please answer y or n. ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1215 args[1] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1216 xprompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1217 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1218 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1219 UNGCPRO;
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
1220
2525
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1221 if (! noninteractive)
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1222 {
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1223 cursor_in_echo_area = -1;
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1224 message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1225 cursor_in_echo_area = ocech;
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1226 }
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
1227
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1228 return answer ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1229 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1230
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1231 /* This is how C code calls `yes-or-no-p' and allows the user
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1232 to redefined it.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1233
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1234 Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1235
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1236 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1237 do_yes_or_no_p (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1238 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1239 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1240 return call1 (intern ("yes-or-no-p"), prompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1241 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1242
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1243 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1244
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1245 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
759
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
1246 "Ask user a yes-or-no question. Return t if answer is yes.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
1247 Takes one argument, which is the string to display to ask the question.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
1248 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
1249 The user must confirm the answer with RET,\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
1250 and can edit it until it as been confirmed.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1251 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1252 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1253 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1254 register Lisp_Object ans;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1255 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1256 struct gcpro gcpro1;
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1257 Lisp_Object menu;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1258
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1259 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1260
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1261 #ifdef HAVE_X_MENU
7790
75153e2d5d85 (Fy_or_n_p): Don't use dialog box if not an X frame.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
1262 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
75153e2d5d85 (Fy_or_n_p): Don't use dialog box if not an X frame.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
1263 && using_x_p ())
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1264 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1265 Lisp_Object pane, menu, obj;
7815
5d167db8ce8a (Fy_or_n_p, Fyes_or_no_p) [HAVE_X_MENU]: Redisplay before popping up a menu.
Karl Heuer <kwzh@gnu.org>
parents: 7790
diff changeset
1266 redisplay_preserve_echo_area ();
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1267 pane = Fcons (Fcons (build_string ("Yes"), Qt),
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1268 Fcons (Fcons (build_string ("No"), Qnil),
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1269 Qnil));
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1270 GCPRO1 (pane);
6478
65c2e184b5d9 (Fy_or_n_p, Fyes_or_no_p): Call Fx_popup_dialog the new way.
Richard M. Stallman <rms@gnu.org>
parents: 6427
diff changeset
1271 menu = Fcons (prompt, pane);
6344
4ef6b636dc99 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 6303
diff changeset
1272 obj = Fx_popup_dialog (Qt, menu);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1273 UNGCPRO;
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1274 return obj;
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1275 }
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1276 #endif
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1277
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1278 args[0] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1279 args[1] = build_string ("(yes or no) ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1280 prompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1281
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1282 GCPRO1 (prompt);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1283
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1284 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1285 {
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
1286 ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
1287 Qyes_or_no_p_history));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1288 if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1289 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1290 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1291 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1292 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1293 if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1294 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1295 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1296 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1297 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1298
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1299 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1300 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1301 message ("Please answer yes or no.");
1045
2ac1c701fced * fns.c (Fyes_or_no_p): Call Fsleep_for with the appropriate
Jim Blandy <jimb@redhat.com>
parents: 1037
diff changeset
1302 Fsleep_for (make_number (2), Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1303 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1304 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1305
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1306 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1307 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1308 Each of the three load averages is multiplied by 100,\n\
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1309 then converted to integer.\n\
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1310 If the 5-minute or 15-minute load averages are not available, return a\n\
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1311 shortened list, containing only those averages which are available.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1312 ()
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1313 {
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1314 double load_ave[3];
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1315 int loads = getloadavg (load_ave, 3);
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1316 Lisp_Object ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1317
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1318 if (loads < 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1319 error ("load-average not implemented for this operating system");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1320
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1321 ret = Qnil;
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1322 while (loads > 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1323 ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1325 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1326 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1327
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1328 Lisp_Object Vfeatures;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1329
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1330 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1331 "Returns t if FEATURE is present in this Emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1332 Use this to conditionalize execution of lisp code based on the presence or\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1333 absence of emacs or environment extensions.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1334 Use `provide' to declare that a feature is available.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1335 This function looks at the value of the variable `features'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1336 (feature)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1337 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1338 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1339 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1340 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1341 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1342 return (NILP (tem)) ? Qnil : Qt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1343 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1344
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1345 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1346 "Announce that FEATURE is a feature of the current Emacs.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1347 (feature)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1348 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1349 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1350 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1351 CHECK_SYMBOL (feature, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1352 if (!NILP (Vautoload_queue))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1353 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1354 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1355 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1356 Vfeatures = Fcons (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1357 LOADHIST_ATTACH (Fcons (Qprovide, feature));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1359 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1360
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1361 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1362 "If feature FEATURE is not loaded, load it from FILENAME.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1363 If FEATURE is not a member of the list `features', then the feature\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1364 is not loaded; so load the file FILENAME.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1365 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1366 (feature, file_name)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1367 Lisp_Object feature, file_name;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1368 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1369 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1370 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1371 tem = Fmemq (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1372 LOADHIST_ATTACH (Fcons (Qrequire, feature));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1373 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1374 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1375 int count = specpdl_ptr - specpdl;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1376
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1377 /* Value saved here is to be restored into Vautoload_queue */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1378 record_unwind_protect (un_autoload, Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1379 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1380
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1381 Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1382 Qnil, Qt, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1383
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1384 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1385 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1386 error ("Required feature %s was not provided",
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1387 XSYMBOL (feature)->name->data );
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1388
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1389 /* Once loading finishes, don't undo it. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1390 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1391 feature = unbind_to (count, feature);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1392 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1393 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1394 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1395
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1396 syms_of_fns ()
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1397 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1398 Qstring_lessp = intern ("string-lessp");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1399 staticpro (&Qstring_lessp);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1400 Qprovide = intern ("provide");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1401 staticpro (&Qprovide);
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1402 Qrequire = intern ("require");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1403 staticpro (&Qrequire);
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
1404 Qyes_or_no_p_history = intern ("yes-or-no-p-history");
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
1405 staticpro (&Qyes_or_no_p_history);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1406
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1407 DEFVAR_LISP ("features", &Vfeatures,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1408 "A list of symbols which are the features of the executing emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1409 Used by `featurep' and `require', and altered by `provide'.");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1410 Vfeatures = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1411
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1412 defsubr (&Sidentity);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1413 defsubr (&Srandom);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1414 defsubr (&Slength);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1415 defsubr (&Sstring_equal);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1416 defsubr (&Sstring_lessp);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1417 defsubr (&Sappend);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1418 defsubr (&Sconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1419 defsubr (&Svconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1420 defsubr (&Scopy_sequence);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421 defsubr (&Scopy_alist);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422 defsubr (&Ssubstring);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1423 defsubr (&Snthcdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1424 defsubr (&Snth);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1425 defsubr (&Selt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1426 defsubr (&Smember);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1427 defsubr (&Smemq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1428 defsubr (&Sassq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1429 defsubr (&Sassoc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430 defsubr (&Srassq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1431 defsubr (&Sdelq);
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
1432 defsubr (&Sdelete);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1433 defsubr (&Snreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1434 defsubr (&Sreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1435 defsubr (&Ssort);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1436 defsubr (&Sget);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1437 defsubr (&Sput);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1438 defsubr (&Sequal);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1439 defsubr (&Sfillarray);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1440 defsubr (&Snconc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1441 defsubr (&Smapcar);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1442 defsubr (&Smapconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1443 defsubr (&Sy_or_n_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1444 defsubr (&Syes_or_no_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1445 defsubr (&Sload_average);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1446 defsubr (&Sfeaturep);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1447 defsubr (&Srequire);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1448 defsubr (&Sprovide);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1449 }