annotate src/fns.c @ 18263:5e9d099a4751

Fix previous change.
author Richard M. Stallman <rms@gnu.org>
date Sun, 15 Jun 1997 19:43:01 +0000
parents af791b0f0657
children 8b716cb12cdd
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.
11235
e6bdaaa6ce1b Update copyright.
Karl Heuer <kwzh@gnu.org>
parents: 11221
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95 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
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
8 the Free Software Foundation; either version 2, or (at your option)
211
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
14186
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14097
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14097
diff changeset
19 Boston, MA 02111-1307, USA. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4616
diff changeset
22 #include <config.h>
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 /* Note on some machines this defines `vector' as a typedef,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
25 so make sure we don't use that name in this file. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26 #undef vector
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
27 #define vector *****
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 #include "lisp.h"
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 #include "commands.h"
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
31 #include "charset.h"
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
32
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33 #include "buffer.h"
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
34 #include "keyboard.h"
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
35 #include "intervals.h"
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
36 #include "frame.h"
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
37 #include "window.h"
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38
12062
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
39 #ifndef NULL
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
40 #define NULL (void *)0
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
41 #endif
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
42
8901
ab65a3dae221 (Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents: 8388
diff changeset
43 extern Lisp_Object Flookup_key ();
ab65a3dae221 (Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents: 8388
diff changeset
44
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
45 extern int minibuffer_auto_raise;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
46 extern Lisp_Object minibuf_window;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
47
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
48 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
49 Lisp_Object Qyes_or_no_p_history;
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
50 Lisp_Object Qcursor_in_echo_area;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
51
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
52 static int internal_equal ();
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
53
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
54 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
55 "Return the argument unchanged.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
56 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
57 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59 return arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
60 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
62 extern long get_random ();
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
63 extern void seed_random ();
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
64 extern long time ();
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
65
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
66 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67 "Return a pseudo-random number.\n\
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
68 All integers representable in Lisp are equally likely.\n\
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
69 On most systems, this is 28 bits' worth.\n\
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
70 With positive integer argument N, return random number in interval [0,N).\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
71 With argument t, set the random number seed from the current time and pid.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
72 (n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
73 Lisp_Object n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 {
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
75 EMACS_INT val;
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
76 Lisp_Object lispy_val;
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
77 unsigned long denominator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
78
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
79 if (EQ (n, Qt))
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
80 seed_random (getpid () + time (NULL));
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
81 if (NATNUMP (n) && XFASTINT (n) != 0)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 {
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
83 /* Try to take our random number from the higher bits of VAL,
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
84 not the lower, since (says Gentzel) the low bits of `random'
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
85 are less random than the higher ones. We do this by using the
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
86 quotient rather than the remainder. At the high end of the RNG
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
87 it's possible to get a quotient larger than n; discarding
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
88 these values eliminates the bias that would otherwise appear
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
89 when using a large n. */
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
90 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
91 do
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
92 val = get_random () / denominator;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
93 while (val >= XFASTINT (n));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 }
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
95 else
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
96 val = get_random ();
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
97 XSETINT (lispy_val, val);
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
98 return lispy_val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
101 /* Random data-structure functions */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
102
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 DEFUN ("length", Flength, Slength, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104 "Return the length of vector, list or string SEQUENCE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 A byte-code function object is also allowed.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
106 (sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
107 register Lisp_Object sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 register Lisp_Object tail, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 retry:
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
113 if (STRINGP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
114 XSETFASTINT (val, XSTRING (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
115 else if (VECTORP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
116 XSETFASTINT (val, XVECTOR (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
117 else if (CHAR_TABLE_P (sequence))
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
118 XSETFASTINT (val, CHAR_TABLE_ORDINARY_SLOTS);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
119 else if (BOOL_VECTOR_P (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
120 XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
121 else if (COMPILEDP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
122 XSETFASTINT (val, XVECTOR (sequence)->size & PSEUDOVECTOR_SIZE_MASK);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
123 else if (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
125 for (i = 0, tail = sequence; !NILP (tail); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 tail = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130
9308
2c594629baaa (Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9289
diff changeset
131 XSETFASTINT (val, i);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 }
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
133 else if (NILP (sequence))
9965
f68eab303ddb (Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents: 9927
diff changeset
134 XSETFASTINT (val, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
137 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 }
9965
f68eab303ddb (Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents: 9927
diff changeset
140 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
143 /* This does not check for quits. That is safe
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
144 since it must terminate. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
145
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
146 DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
147 "Return the length of a list, but avoid error or infinite loop.\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
148 This function never gets an error. If LIST is not really a list,\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
149 it returns 0. If LIST is circular, it returns a finite value\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
150 which is at least the number of distinct elements.")
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
151 (list)
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
152 Lisp_Object list;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
153 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
154 Lisp_Object tail, halftail, length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
155 int len = 0;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
156
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
157 /* halftail is used to detect circular lists. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
158 halftail = list;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
159 for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
160 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
161 if (EQ (tail, halftail) && len != 0)
12618
60c4c0fee545 (Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents: 12466
diff changeset
162 break;
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
163 len++;
13344
30e17254a280 (Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents: 13277
diff changeset
164 if ((len & 1) == 0)
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
165 halftail = XCONS (halftail)->cdr;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
166 }
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
167
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
168 XSETINT (length, len);
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
169 return length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
170 }
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
171
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 "T if two strings have identical contents.\n\
10114
6f6db8f5b8a0 (internal_equal): Call compare_string_intervals.
Richard M. Stallman <rms@gnu.org>
parents: 10059
diff changeset
174 Case is significant, but text properties are ignored.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
179 if (SYMBOLP (s1))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
180 XSETSTRING (s1, XSYMBOL (s1)->name);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
181 if (SYMBOLP (s2))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
182 XSETSTRING (s2, XSYMBOL (s2)->name);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186 if (XSTRING (s1)->size != XSTRING (s2)->size ||
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187 bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
188 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
190 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
191
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
192 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 "T if first arg string is less than second in lexicographic order.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 Case is significant.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
196 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
199 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
200 register unsigned char *p1, *p2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
201 register int end;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
202
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
203 if (SYMBOLP (s1))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
204 XSETSTRING (s1, XSYMBOL (s1)->name);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
205 if (SYMBOLP (s2))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
206 XSETSTRING (s2, XSYMBOL (s2)->name);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
207 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
208 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
209
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
210 p1 = XSTRING (s1)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
211 p2 = XSTRING (s2)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
212 end = XSTRING (s1)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
213 if (end > XSTRING (s2)->size)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 end = XSTRING (s2)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 for (i = 0; i < end; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
218 if (p1[i] != p2[i])
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
219 return p1[i] < p2[i] ? Qt : Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 return i < XSTRING (s2)->size ? Qt : Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224 static Lisp_Object concat ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
225
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 concat2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
230 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
231 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
235 return concat (2, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237 return concat (2, &s1, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
238 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
239 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
240
8966
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
241 /* ARGSUSED */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
242 Lisp_Object
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
243 concat3 (s1, s2, s3)
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
244 Lisp_Object s1, s2, s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
245 {
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
246 #ifdef NO_ARG_ARRAY
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
247 Lisp_Object args[3];
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
248 args[0] = s1;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
249 args[1] = s2;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
250 args[2] = s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
251 return concat (3, args, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
252 #else
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
253 return concat (3, &s1, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
254 #endif /* NO_ARG_ARRAY */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
255 }
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
256
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
257 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
258 "Concatenate all the arguments and make the result a list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
259 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
260 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
261 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
262 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
263 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
264 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
265 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
266 return concat (nargs, args, Lisp_Cons, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
267 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
268
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
269 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
270 "Concatenate all the arguments and make the result a string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
271 The result is a string whose elements are the elements of all the arguments.\n\
11142
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
272 Each argument may be a string or a list or vector of characters (integers).\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
273 \n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
274 Do not use individual integers as arguments!\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
275 The behavior of `concat' in that case will be changed later!\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
276 If your program passes an integer as an argument to `concat',\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
277 you should change it right away not to do so.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
278 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282 return concat (nargs, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
283 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
284
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 "Concatenate all the arguments and make the result a vector.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287 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
288 Each argument may be a list, vector or string.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292 {
10006
402c87cbc4fa (Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9965
diff changeset
293 return concat (nargs, args, Lisp_Vectorlike, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
296 /* Retrun a copy of a sub char table ARG. The elements except for a
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
297 nested sub char table are not copied. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
298 static Lisp_Object
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
299 copy_sub_char_table (arg)
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
300 Lisp_Object arg;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
301 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
302 Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
303 int i;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
304
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
305 /* Copy all the contents. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
306 bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
307 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
308 /* Recursively copy any sub char-tables in the ordinary slots. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
309 for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
310 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
311 XCHAR_TABLE (copy)->contents[i]
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
312 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
313
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
314 return copy;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
315 }
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
316
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
317
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
318 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
319 "Return a copy of a list, vector or string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
320 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
321 with the original.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
322 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
323 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
324 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
325 if (NILP (arg)) return arg;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
326
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
327 if (CHAR_TABLE_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
328 {
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
329 int i;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
330 Lisp_Object copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
331
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
332 copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
333 /* Copy all the slots, including the extra ones. */
17819
6fd66459ec9a (Fcopy_sequence): Correctly copy the char-table contents.
Richard M. Stallman <rms@gnu.org>
parents: 17789
diff changeset
334 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
335 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
336 * sizeof (Lisp_Object)));
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
337
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
338 /* Recursively copy any sub char tables in the ordinary slots
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
339 for multibyte characters. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
340 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
341 i < CHAR_TABLE_ORDINARY_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
342 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
343 XCHAR_TABLE (copy)->contents[i]
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
344 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
345
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
346 return copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
347 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
348
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
349 if (BOOL_VECTOR_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
350 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
351 Lisp_Object val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
352 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
353 = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
354
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
355 val = Fmake_bool_vector (Flength (arg), Qnil);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
356 bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
357 size_in_chars);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
358 return val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
359 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
360
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
361 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 arg = wrong_type_argument (Qsequencep, arg);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
366 static Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367 concat (nargs, args, target_type, last_special)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
369 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 enum Lisp_Type target_type;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371 int last_special;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373 Lisp_Object val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
375 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
376 register Lisp_Object this;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 int toindex;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
378 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 Lisp_Object last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 Lisp_Object prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383 /* In append, the last arg isn't treated like the others */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 if (last_special && nargs > 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 nargs--;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 last_tail = args[nargs];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390 last_tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
394 this = args[argnum];
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
395 if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
396 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
398 if (INTEGERP (this))
11142
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
399 args[argnum] = Fnumber_to_string (this);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 args[argnum] = wrong_type_argument (Qsequencep, this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
403 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
404
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
405 for (argnum = 0, leni = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 this = args[argnum];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408 len = Flength (this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 leni += XFASTINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411
9308
2c594629baaa (Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9289
diff changeset
412 XSETFASTINT (len, leni);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
414 if (target_type == Lisp_Cons)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 val = Fmake_list (len, Qnil);
10006
402c87cbc4fa (Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9965
diff changeset
416 else if (target_type == Lisp_Vectorlike)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417 val = Fmake_vector (len, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 val = Fmake_string (len, len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421 /* In append, if all but last arg are nil, return last arg */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 if (target_type == Lisp_Cons && EQ (val, Qnil))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
423 return last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
425 if (CONSP (val))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 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
427 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 toindex = 0;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434 Lisp_Object thislen;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 int thisleni;
16863
591b7a95d7a5 (concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents: 16561
diff changeset
436 register unsigned int thisindex = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 this = args[argnum];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
439 if (!CONSP (this))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 thislen = Flength (this), thisleni = XINT (thislen);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
442 if (STRINGP (this) && STRINGP (val)
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
443 && ! 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
444 {
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
445 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
446 make_number (toindex), val, Qnil);
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
447 }
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
448
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
449 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
450 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
452
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
453 /* 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
454 `this' is exhausted. */
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
455 if (NILP (this)) break;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456 if (CONSP (this))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457 elt = Fcar (this), this = Fcdr (this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
459 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
460 if (thisindex >= thisleni) break;
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
461 if (STRINGP (this))
9308
2c594629baaa (Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9289
diff changeset
462 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
463 else if (BOOL_VECTOR_P (this))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
464 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
465 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
466 = ((XBOOL_VECTOR (this)->size + BITS_PER_CHAR - 1)
13363
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13344
diff changeset
467 / BITS_PER_CHAR);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
468 int byte;
13363
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13344
diff changeset
469 byte = XBOOL_VECTOR (val)->data[thisindex / BITS_PER_CHAR];
16863
591b7a95d7a5 (concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents: 16561
diff changeset
470 if (byte & (1 << (thisindex % BITS_PER_CHAR)))
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
471 elt = Qt;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
472 else
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
473 elt = Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
474 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
475 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476 elt = XVECTOR (this)->contents[thisindex++];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 /* Store into result */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 if (toindex < 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 XCONS (tail)->car = elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 tail = XCONS (tail)->cdr;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 }
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
486 else if (VECTORP (val))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 XVECTOR (val)->contents[toindex++] = elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
488 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
490 while (!INTEGERP (elt))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 elt = wrong_type_argument (Qintegerp, elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
492 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493 #ifdef MASSC_REGISTER_BUG
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
494 /* Even removing all "register"s doesn't disable this bug!
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495 Nothing simpler than this seems to work. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496 unsigned char *p = & XSTRING (val)->data[toindex++];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
497 *p = XINT (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
498 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
499 XSTRING (val)->data[toindex++] = XINT (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
500 #endif
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
501 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
502 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
503 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
504 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
505 if (!NILP (prev))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
506 XCONS (prev)->cdr = last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
507
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
508 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
509 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 "Return a copy of ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513 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
514 but does not share the alist structure with ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
515 The objects mapped (cars and cdrs of elements of the alist)\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 are shared, however.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517 Elements of ALIST that are not conses are also shared.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 (alist)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 Lisp_Object alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 CHECK_LIST (alist, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
524 if (NILP (alist))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 alist = concat (1, &alist, Lisp_Cons, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 register Lisp_Object car;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 car = XCONS (tem)->car;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
531
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
532 if (CONSP (car))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
533 XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
535 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
536 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539 "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
540 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
541 If FROM or TO is negative, it counts from the end.\n\
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
542 \n\
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
543 This function allows vectors as well as strings.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544 (string, from, to)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
545 Lisp_Object string;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546 register Lisp_Object from, to;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
547 {
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
548 Lisp_Object res;
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
549 int size;
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
550
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
551 if (! (STRINGP (string) || VECTORP (string)))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
552 wrong_type_argument (Qarrayp, string);
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
553
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
554 CHECK_NUMBER (from, 1);
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
555
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
556 if (STRINGP (string))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
557 size = XSTRING (string)->size;
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
558 else
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
559 size = XVECTOR (string)->size;
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
560
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
561 if (NILP (to))
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
562 to = size;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 CHECK_NUMBER (to, 2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 if (XINT (from) < 0)
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
567 XSETINT (from, XINT (from) + size);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 if (XINT (to) < 0)
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
569 XSETINT (to, XINT (to) + size);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
570 if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
571 && XINT (to) <= size))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
572 args_out_of_range_3 (string, from, to);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
574 if (STRINGP (string))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
575 {
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
576 res = make_string (XSTRING (string)->data + XINT (from),
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
577 XINT (to) - XINT (from));
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
578 copy_text_properties (from, to, string, make_number (0), res, Qnil);
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
579 }
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
580 else
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
581 res = Fvector (XINT (to) - XINT (from),
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
582 XVECTOR (string)->contents + XINT (from));
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
583
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
584 return res;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
585 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
586
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
587 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
588 "Take cdr N times on LIST, returns the result.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 Lisp_Object n;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591 register Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593 register int i, num;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 num = XINT (n);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
596 for (i = 0; i < num && !NILP (list); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
597 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
598 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
599 list = Fcdr (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
601 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
602 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
604 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
605 "Return the Nth element of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
606 N counts from zero. If LIST is not that long, nil is returned.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
607 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
608 Lisp_Object n, list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
609 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
610 return Fcar (Fnthcdr (n, list));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
611 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
612
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
613 DEFUN ("elt", Felt, Selt, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
614 "Return element of SEQUENCE at index N.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
615 (sequence, n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
616 register Lisp_Object sequence, n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
617 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
618 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
619 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
620 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
621 if (CONSP (sequence) || NILP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
622 return Fcar (Fnthcdr (n, sequence));
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
623 else if (STRINGP (sequence) || VECTORP (sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
624 || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
625 return Faref (sequence, n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
626 else
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
627 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
628 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
629 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
630
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
631 DEFUN ("member", Fmember, Smember, 2, 2, 0,
6990
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
632 "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
633 The value is actually the tail of LIST whose car is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
634 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
635 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
636 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
637 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
638 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
639 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
640 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
641 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
642 tem = Fcar (tail);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
643 if (! NILP (Fequal (elt, tem)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
644 return 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 Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
648 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
649
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
650 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
651 "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
652 The value is actually the tail of LIST whose car is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
653 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
654 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
655 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
656 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
657 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
658 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
659 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
660 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
661 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
662 if (EQ (elt, tem)) return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
663 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
664 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
665 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
666 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
667
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
668 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
669 "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
670 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
671 Elements of LIST that are not conses are ignored.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
672 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
673 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
674 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
675 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
676 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
677 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
678 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
679 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
680 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
681 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
682 tem = Fcar (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
683 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
684 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
685 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
686 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
687 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
688
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
689 /* Like Fassq but never report an error and do not allow quits.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
690 Use only on lists known never to be circular. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
691
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
692 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
693 assq_no_quit (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
694 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
695 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
696 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
698 for (tail = list; CONSP (tail); tail = Fcdr (tail))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
699 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
700 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
701 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
702 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703 tem = Fcar (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
705 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
706 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
707 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
708
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
709 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
710 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
711 The value is actually the element of LIST whose car equals KEY.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
712 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
713 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
714 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
715 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
716 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
717 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
718 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
719 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
720 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
721 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
722 tem = Fequal (Fcar (elt), key);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
723 if (!NILP (tem)) return elt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
725 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
726 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
727 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
728
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
729 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
730 "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
731 The value is actually the element of LIST whose cdr is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
732 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
733 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
734 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
735 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
736 register Lisp_Object tail;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
737 for (tail = list; !NILP (tail); tail = Fcdr (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
738 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
739 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
740 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
741 if (!CONSP (elt)) continue;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
742 tem = Fcdr (elt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
743 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
744 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
745 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
746 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
747 }
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
748
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
749 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
750 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
751 The value is actually the element of LIST whose cdr equals KEY.")
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
752 (key, list)
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
753 register Lisp_Object key;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
754 Lisp_Object list;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
755 {
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
756 register Lisp_Object tail;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
757 for (tail = list; !NILP (tail); tail = Fcdr (tail))
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
758 {
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
759 register Lisp_Object elt, tem;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
760 elt = Fcar (tail);
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
761 if (!CONSP (elt)) continue;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
762 tem = Fequal (Fcdr (elt), key);
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
763 if (!NILP (tem)) return elt;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
764 QUIT;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
765 }
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
766 return Qnil;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
767 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
768
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
769 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
770 "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
771 The modified LIST is returned. Comparison is done with `eq'.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
772 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
773 therefore, write `(setq foo (delq element foo))'\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
774 to be sure of changing the value of `foo'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
775 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
776 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
777 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
778 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
779 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
780 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
781
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
782 tail = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
783 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
784 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
785 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
786 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
787 if (EQ (elt, tem))
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 (prev))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
790 list = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
791 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
792 Fsetcdr (prev, Fcdr (tail));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
793 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
794 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
795 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
796 tail = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
797 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
798 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
799 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
800 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
801
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
802 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
803 "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
804 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
805 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
806 it is simply using a different list.\n\
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
807 Therefore, write `(setq foo (delete element foo))'\n\
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
808 to be sure of changing the value of `foo'.")
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
809 (elt, list)
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
810 register Lisp_Object elt;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
811 Lisp_Object list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
812 {
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
813 register Lisp_Object tail, prev;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
814 register Lisp_Object tem;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
815
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
816 tail = list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
817 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
818 while (!NILP (tail))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
819 {
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
820 tem = Fcar (tail);
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
821 if (! NILP (Fequal (elt, tem)))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
822 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
823 if (NILP (prev))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
824 list = Fcdr (tail);
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
825 else
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
826 Fsetcdr (prev, Fcdr (tail));
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
827 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
828 else
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
829 prev = tail;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
830 tail = Fcdr (tail);
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
831 QUIT;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
832 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
833 return list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
834 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
835
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
836 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
837 "Reverse LIST by modifying cdr pointers.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
838 Returns the beginning of the reversed list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
839 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
840 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
841 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
842 register Lisp_Object prev, tail, next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
843
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
844 if (NILP (list)) return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
845 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
846 tail = list;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
847 while (!NILP (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 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
850 next = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
851 Fsetcdr (tail, prev);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
852 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
853 tail = next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
854 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
855 return prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
856 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
857
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
858 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
859 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
860 See also the function `nreverse', which is used more often.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
861 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
862 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
863 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
864 Lisp_Object length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
865 register Lisp_Object *vec;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
866 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
867 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
868
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
869 length = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
870 vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
871 for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
872 vec[i] = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
873
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
874 return Flist (XINT (length), vec);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
875 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
876
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
877 Lisp_Object merge ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
878
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
879 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
880 "Sort LIST, stably, comparing elements using PREDICATE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
881 Returns the sorted list. LIST is modified by side effects.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
882 PREDICATE is called with two elements of LIST, and should return T\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
883 if the first element is \"less\" than the second.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
884 (list, predicate)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
885 Lisp_Object list, predicate;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
886 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
887 Lisp_Object front, back;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
888 register Lisp_Object len, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
889 struct gcpro gcpro1, gcpro2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
890 register int length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
891
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
892 front = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
893 len = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
894 length = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
895 if (length < 2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
896 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
897
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
898 XSETINT (len, (length / 2) - 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
899 tem = Fnthcdr (len, list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
900 back = Fcdr (tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
901 Fsetcdr (tem, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
902
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
903 GCPRO2 (front, back);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
904 front = Fsort (front, predicate);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
905 back = Fsort (back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
906 UNGCPRO;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
907 return merge (front, back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
908 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
909
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
910 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
911 merge (org_l1, org_l2, pred)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
912 Lisp_Object org_l1, org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
913 Lisp_Object pred;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
914 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
915 Lisp_Object value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
916 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
917 Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
918 register Lisp_Object l1, l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
919 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
920
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
921 l1 = org_l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
922 l2 = org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
923 tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
924 value = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
925
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
926 /* It is sufficient to protect org_l1 and org_l2.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
927 When l1 and l2 are updated, we copy the new values
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
928 back into the org_ vars. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
929 GCPRO4 (org_l1, org_l2, pred, value);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
930
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
931 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
932 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
933 if (NILP (l1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
934 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
935 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
936 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
937 return l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
938 Fsetcdr (tail, l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
939 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
940 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
941 if (NILP (l2))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
942 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
943 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
944 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
945 return l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
946 Fsetcdr (tail, l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
947 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
948 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
949 tem = call2 (pred, Fcar (l2), Fcar (l1));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
950 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
951 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
952 tem = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
953 l1 = Fcdr (l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
954 org_l1 = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
955 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
956 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
957 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
958 tem = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
959 l2 = Fcdr (l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
960 org_l2 = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
961 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
962 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
963 value = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
964 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
965 Fsetcdr (tail, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
966 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
967 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
968 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
969
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
970
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
971 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
972 "Extract a value from a property list.\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
973 PLIST is a property list, which is a list of the form\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
974 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
975 corresponding to the given PROP, or nil if PROP is not\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
976 one of the properties on the list.")
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
977 (plist, prop)
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
978 Lisp_Object plist;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
979 register Lisp_Object prop;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
980 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
981 register Lisp_Object tail;
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
982 for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
983 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
984 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
985 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
986 if (EQ (prop, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
987 return Fcar (Fcdr (tail));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
988 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
989 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
990 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
991
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
992 DEFUN ("get", Fget, Sget, 2, 2, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
993 "Return the value of SYMBOL's PROPNAME property.\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
994 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
995 (symbol, propname)
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
996 Lisp_Object symbol, propname;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
997 {
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
998 CHECK_SYMBOL (symbol, 0);
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
999 return Fplist_get (XSYMBOL (symbol)->plist, propname);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1000 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1001
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1002 DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1003 "Change value in PLIST of PROP to VAL.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1004 PLIST is a property list, which is a list of the form\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1005 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1006 If PROP is already a property on the list, its value is set to VAL,\n\
11221
254a5316fc98 (Fplist_put): Fix missing \n\.
Karl Heuer <kwzh@gnu.org>
parents: 11194
diff changeset
1007 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1008 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1009 The PLIST is modified by side effects.")
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1010 (plist, prop, val)
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1011 Lisp_Object plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1012 register Lisp_Object prop;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1013 Lisp_Object val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1014 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1015 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1016 Lisp_Object newcell;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1017 prev = Qnil;
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1018 for (tail = plist; CONSP (tail) && CONSP (XCONS (tail)->cdr);
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1019 tail = XCONS (XCONS (tail)->cdr)->cdr)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1020 {
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1021 if (EQ (prop, XCONS (tail)->car))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1022 {
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1023 Fsetcar (XCONS (tail)->cdr, val);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1024 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1025 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1026 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1027 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1028 newcell = Fcons (prop, Fcons (val, Qnil));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1029 if (NILP (prev))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1030 return newcell;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1031 else
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1032 Fsetcdr (XCONS (prev)->cdr, newcell);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1033 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1034 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1035
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1036 DEFUN ("put", Fput, Sput, 3, 3, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1037 "Store SYMBOL's PROPNAME property with value VALUE.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1038 It can be retrieved with `(get SYMBOL PROPNAME)'.")
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1039 (symbol, propname, value)
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1040 Lisp_Object symbol, propname, value;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1041 {
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1042 CHECK_SYMBOL (symbol, 0);
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1043 XSYMBOL (symbol)->plist
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1044 = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1045 return value;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1046 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1047
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1048 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1049 "T if two Lisp objects have similar structure and contents.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1050 They must have the same data type.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1051 Conses are compared by comparing the cars and the cdrs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1052 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
1053 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
1054 (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
1055 Symbols must match exactly.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1056 (o1, o2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 register Lisp_Object o1, o2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1058 {
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1059 return internal_equal (o1, o2, 0) ? Qt : Qnil;
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1060 }
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1061
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1062 static int
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1063 internal_equal (o1, o2, depth)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1064 register Lisp_Object o1, o2;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1065 int depth;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1066 {
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1067 if (depth > 200)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1068 error ("Stack overflow in equal");
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1069
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1070 tail_recurse:
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1071 QUIT;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1072 if (EQ (o1, o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1073 return 1;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1074 if (XTYPE (o1) != XTYPE (o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1075 return 0;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1076
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1077 switch (XTYPE (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1078 {
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1079 #ifdef LISP_FLOAT_TYPE
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1080 case Lisp_Float:
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1081 return (extract_float (o1) == extract_float (o2));
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1082 #endif
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1083
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1084 case Lisp_Cons:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1085 if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1))
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1086 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1087 o1 = XCONS (o1)->cdr;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1088 o2 = XCONS (o2)->cdr;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1089 goto tail_recurse;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1090
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1091 case Lisp_Misc:
11240
2642924d2d21 (internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
1092 if (XMISCTYPE (o1) != XMISCTYPE (o2))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1093 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1094 if (OVERLAYP (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1095 {
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1096 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1),
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1097 depth + 1)
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1098 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o1),
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1099 depth + 1))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1100 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1101 o1 = XOVERLAY (o1)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1102 o2 = XOVERLAY (o2)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1103 goto tail_recurse;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1104 }
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1105 if (MARKERP (o1))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1106 {
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1107 return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1108 && (XMARKER (o1)->buffer == 0
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1109 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1110 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1111 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1112
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1113 case Lisp_Vectorlike:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1114 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1115 register int i, size;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1116 size = XVECTOR (o1)->size;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1117 /* Pseudovectors have the type encoded in the size field, so this test
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1118 actually checks that the objects have the same type as well as the
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1119 same size. */
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1120 if (XVECTOR (o2)->size != size)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1121 return 0;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1122 /* Boolvectors are compared much like strings. */
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1123 if (BOOL_VECTOR_P (o1))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1124 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1125 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
1126 = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1127
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1128 if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1129 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1130 if (bcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1131 size_in_chars))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1132 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1133 return 1;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1134 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1135
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1136 /* Aside from them, only true vectors, char-tables, and compiled
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1137 functions are sensible to compare, so eliminate the others now. */
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1138 if (size & PSEUDOVECTOR_FLAG)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1139 {
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1140 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1141 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1142 size &= PSEUDOVECTOR_SIZE_MASK;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1143 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1144 for (i = 0; i < size; i++)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1145 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1146 Lisp_Object v1, v2;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1147 v1 = XVECTOR (o1)->contents [i];
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1148 v2 = XVECTOR (o2)->contents [i];
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1149 if (!internal_equal (v1, v2, depth + 1))
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1150 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1151 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1152 return 1;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1153 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1154 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1155
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1156 case Lisp_String:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1157 if (XSTRING (o1)->size != XSTRING (o2)->size)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1158 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1159 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data,
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1160 XSTRING (o1)->size))
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1161 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1162 return 1;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1163 }
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1164 return 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1165 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1166
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1167 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1168 "Store each element of ARRAY with ITEM.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1169 ARRAY is a vector, string, char-table, or bool-vector.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1170 (array, item)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1171 Lisp_Object array, item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1172 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1173 register int size, index, charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1174 retry:
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1175 if (VECTORP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1176 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1177 register Lisp_Object *p = XVECTOR (array)->contents;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1178 size = XVECTOR (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1179 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1180 p[index] = item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1181 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1182 else if (CHAR_TABLE_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1183 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1184 register Lisp_Object *p = XCHAR_TABLE (array)->contents;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1185 size = CHAR_TABLE_ORDINARY_SLOTS;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1186 for (index = 0; index < size; index++)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1187 p[index] = item;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1188 XCHAR_TABLE (array)->defalt = Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1189 }
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1190 else if (STRINGP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1191 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1192 register unsigned char *p = XSTRING (array)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1193 CHECK_NUMBER (item, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1194 charval = XINT (item);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1195 size = XSTRING (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1196 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1197 p[index] = charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1198 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1199 else if (BOOL_VECTOR_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1200 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1201 register unsigned char *p = XBOOL_VECTOR (array)->data;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1202 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
1203 = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1204
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1205 charval = (! NILP (item) ? -1 : 0);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1206 for (index = 0; index < size_in_chars; index++)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1207 p[index] = charval;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1208 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1209 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1210 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211 array = wrong_type_argument (Qarrayp, array);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1212 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1213 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1214 return array;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1215 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1216
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1217 DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1218 1, 1, 0,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1219 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1220 (char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1221 Lisp_Object char_table;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1222 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1223 CHECK_CHAR_TABLE (char_table, 0);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1224
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1225 return XCHAR_TABLE (char_table)->purpose;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1226 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1227
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1228 DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1229 1, 1, 0,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1230 "Return the parent char-table of CHAR-TABLE.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1231 The value is either nil or another char-table.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1232 If CHAR-TABLE holds nil for a given character,\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1233 then the actual applicable value is inherited from the parent char-table\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1234 \(or from its parents, if necessary).")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1235 (char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1236 Lisp_Object char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1237 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1238 CHECK_CHAR_TABLE (char_table, 0);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1239
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1240 return XCHAR_TABLE (char_table)->parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1241 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1242
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1243 DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1244 2, 2, 0,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1245 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1246 PARENT must be either nil or another char-table.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1247 (char_table, parent)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1248 Lisp_Object char_table, parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1249 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1250 Lisp_Object temp;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1251
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1252 CHECK_CHAR_TABLE (char_table, 0);
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1253
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1254 if (!NILP (parent))
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1255 {
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1256 CHECK_CHAR_TABLE (parent, 0);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1257
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1258 for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
14097
91c55574973f (Fset_char_table_parent): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 14091
diff changeset
1259 if (EQ (temp, char_table))
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1260 error ("Attempt to make a chartable be its own parent");
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1261 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1262
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1263 XCHAR_TABLE (char_table)->parent = parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1264
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1265 return parent;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1266 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1267
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1268 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1269 2, 2, 0,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
1270 "Return the value of CHAR-TABLE's extra-slot number N.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1271 (char_table, n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1272 Lisp_Object char_table, n;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1273 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1274 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1275 CHECK_NUMBER (n, 2);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1276 if (XINT (n) < 0
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1277 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1278 args_out_of_range (char_table, n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1279
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1280 return XCHAR_TABLE (char_table)->extras[XINT (n)];
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1281 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1282
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1283 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1284 Sset_char_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1285 3, 3, 0,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
1286 "Set CHAR-TABLE's extra-slot number N to VALUE.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1287 (char_table, n, value)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1288 Lisp_Object char_table, n, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1289 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1290 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1291 CHECK_NUMBER (n, 2);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1292 if (XINT (n) < 0
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1293 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1294 args_out_of_range (char_table, n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1295
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1296 return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1297 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1298
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1299 DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1300 2, 2, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1301 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1302 RANGE should be t (for all characters), nil (for the default value)\n\
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1303 a vector which identifies a character set or a row of a character set,\n\
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1304 or a character code.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1305 (char_table, range)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1306 Lisp_Object char_table, range;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1307 {
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1308 int i;
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1309
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1310 CHECK_CHAR_TABLE (char_table, 0);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1311
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1312 if (EQ (range, Qnil))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1313 return XCHAR_TABLE (char_table)->defalt;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1314 else if (INTEGERP (range))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1315 return Faref (char_table, range);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1316 else if (VECTORP (range))
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1317 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1318 if (XVECTOR (range)->size == 1)
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1319 return Faref (char_table, XVECTOR (range)->contents[0]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1320 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1321 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1322 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1323 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1324 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1325 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1326 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1327 return Faref (char_table, ch);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1328 }
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1329 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1330 else
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1331 error ("Invalid RANGE argument to `char-table-range'");
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1332 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1333
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1334 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1335 3, 3, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1336 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1337 RANGE should be t (for all characters), nil (for the default value)\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1338 a vector which identifies a character set or a row of a character set,\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1339 or a character code.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1340 (char_table, range, value)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1341 Lisp_Object char_table, range, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1342 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1343 int i;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1344
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1345 CHECK_CHAR_TABLE (char_table, 0);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1346
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1347 if (EQ (range, Qt))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1348 for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1349 XCHAR_TABLE (char_table)->contents[i] = value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1350 else if (EQ (range, Qnil))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1351 XCHAR_TABLE (char_table)->defalt = value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1352 else if (INTEGERP (range))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1353 Faset (char_table, range, value);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1354 else if (VECTORP (range))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1355 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1356 if (XVECTOR (range)->size == 1)
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1357 return Faset (char_table, XVECTOR (range)->contents[0], value);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1358 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1359 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1360 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1361 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1362 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1363 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1364 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1365 return Faset (char_table, ch, value);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1366 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1367 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1368 else
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1369 error ("Invalid RANGE argument to `set-char-table-range'");
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1370
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1371 return value;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1372 }
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1373
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1374 DEFUN ("set-char-table-default", Fset_char_table_default,
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1375 Sset_char_table_default, 3, 3, 0,
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1376 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1377 The generic character specifies the group of characters.\n\
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1378 See also the documentation of make-char.")
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1379 (char_table, ch, value)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1380 Lisp_Object char_table, ch, value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1381 {
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1382 int c, i, charset, code1, code2;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1383 Lisp_Object temp;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1384
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1385 CHECK_CHAR_TABLE (char_table, 0);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1386 CHECK_NUMBER (ch, 1);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1387
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1388 c = XINT (ch);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1389 SPLIT_NON_ASCII_CHAR (c, charset, code1, code2);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1390 if (! CHARSET_DEFINED_P (charset))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1391 error ("Invalid character: %d", c);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1392
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1393 if (charset == CHARSET_ASCII)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1394 return (XCHAR_TABLE (char_table)->defalt = value);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1395
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1396 /* Even if C is not a generic char, we had better behave as if a
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1397 generic char is specified. */
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1398 if (CHARSET_DIMENSION (charset) == 1)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1399 code1 = 0;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1400 temp = XCHAR_TABLE (char_table)->contents[charset + 128];
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1401 if (!code1)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1402 {
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1403 if (SUB_CHAR_TABLE_P (temp))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1404 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1405 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1406 XCHAR_TABLE (char_table)->contents[charset + 128] = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1407 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1408 }
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1409 char_table = temp;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1410 if (! SUB_CHAR_TABLE_P (char_table))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1411 char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1412 = make_sub_char_table (temp));
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1413 temp = XCHAR_TABLE (char_table)->contents[code1];
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1414 if (SUB_CHAR_TABLE_P (temp))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1415 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1416 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1417 XCHAR_TABLE (char_table)->contents[code1] = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1418 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1419 }
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1420
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1421
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1422 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1423 character or group of characters that share a value.
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1424 DEPTH is the current depth in the originally specified
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1425 chartable, and INDICES contains the vector indices
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1426 for the levels our callers have descended.
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1427
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1428 ARG is passed to C_FUNCTION when that is called. */
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1429
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1430 void
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1431 map_char_table (c_function, function, subtable, arg, depth, indices)
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1432 Lisp_Object (*c_function) (), function, subtable, arg, *indices;
16105
1712db4a1709 (map_char_table): Declare depth as int.
Richard M. Stallman <rms@gnu.org>
parents: 15966
diff changeset
1433 int depth;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1434 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1435 int i, to;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1436
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
1437 if (depth == 0)
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1438 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1439 /* At first, handle ASCII and 8-bit European characters. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1440 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1441 {
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1442 Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1443 if (c_function)
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1444 (*c_function) (arg, make_number (i), elt);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1445 else
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1446 call2 (function, make_number (i), elt);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1447 }
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1448 to = CHAR_TABLE_ORDINARY_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1449 }
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
1450 else
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1451 {
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1452 i = 0;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1453 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1454 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1455
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1456 for (; i < to; i++)
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1457 {
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1458 Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1459
18108
af791b0f0657 (map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents: 18035
diff changeset
1460 XSETFASTINT (indices[depth], i);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1461
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1462 if (SUB_CHAR_TABLE_P (elt))
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1463 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1464 if (depth >= 3)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1465 error ("Too deep char table");
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1466 map_char_table (c_function, function, elt, arg, depth + 1, indices);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1467 }
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1468 else
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
1469 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1470 int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1471
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
1472 if (CHARSET_DEFINED_P (charset))
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
1473 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1474 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1475 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
1476 c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1477 if (c_function)
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1478 (*c_function) (arg, make_number (c), elt);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1479 else
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1480 call2 (function, make_number (c), elt);
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
1481 }
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1482 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1483 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1484 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1485
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1486 DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1487 2, 2, 0,
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1488 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1489 FUNCTION is called with two arguments--a key and a value.\n\
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1490 The key is always a possible IDX argument to `aref'.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1491 (function, char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1492 Lisp_Object function, char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1493 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
1494 /* The depth of char table is at most 3. */
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1495 Lisp_Object indices[3];
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1496
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
1497 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1498
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1499 map_char_table (NULL, function, char_table, char_table, 0, indices);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1500 return Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1501 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1502
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1503 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1504 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1505 nconc2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1506 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1507 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1508 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1509 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1510 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1511 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1512 return Fnconc (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1513 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1514 return Fnconc (2, &s1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1515 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1516 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1517
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1518 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1519 "Concatenate any number of lists by altering them.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1520 Only the last argument is not altered, and need not be a list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1521 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1522 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1523 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1524 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1525 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1526 register Lisp_Object tail, tem, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1527
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1528 val = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1529
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1530 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1531 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1532 tem = args[argnum];
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1533 if (NILP (tem)) continue;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1534
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1535 if (NILP (val))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1536 val = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1537
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1538 if (argnum + 1 == nargs) break;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1539
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1540 if (!CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1541 tem = wrong_type_argument (Qlistp, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1542
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1543 while (CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1544 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1545 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1546 tem = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1547 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1548 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1550 tem = args[argnum + 1];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1551 Fsetcdr (tail, tem);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1552 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1553 args[argnum + 1] = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1554 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1555
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1556 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1557 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1558
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1559 /* This is the guts of all mapping functions.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1560 Apply fn to each element of seq, one by one,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1561 storing the results into elements of vals, a C vector of Lisp_Objects.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1562 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
1563
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1564 static void
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1565 mapcar1 (leni, vals, fn, seq)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1566 int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1567 Lisp_Object *vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1568 Lisp_Object fn, seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1569 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1570 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1571 Lisp_Object dummy;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1572 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1573 struct gcpro gcpro1, gcpro2, gcpro3;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1574
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1575 /* Don't let vals contain any garbage when GC happens. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1576 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1577 vals[i] = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1578
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1579 GCPRO3 (dummy, fn, seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1580 gcpro1.var = vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1581 gcpro1.nvars = leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1582 /* 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
1583 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
1584
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1585 if (VECTORP (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1586 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1587 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1588 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1589 dummy = XVECTOR (seq)->contents[i];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1590 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1591 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1592 }
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1593 else if (STRINGP (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1594 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1595 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1596 {
9308
2c594629baaa (Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9289
diff changeset
1597 XSETFASTINT (dummy, XSTRING (seq)->data[i]);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1598 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1599 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1600 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1601 else /* Must be a list, since Flength did not get an error */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1602 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1603 tail = seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1604 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1605 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1606 vals[i] = call1 (fn, Fcar (tail));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1607 tail = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1608 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1609 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1610
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1611 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1612 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1613
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1614 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1615 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1616 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1617 SEPARATOR results in spaces between the values returned by FUNCTION.")
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1618 (function, sequence, separator)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1619 Lisp_Object function, sequence, separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1620 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1621 Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1622 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1623 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1624 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1625 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1626 struct gcpro gcpro1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1627
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1628 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1629 leni = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1630 nargs = leni + leni - 1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1631 if (nargs < 0) return build_string ("");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1632
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1633 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1635 GCPRO1 (separator);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1636 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1637 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1638
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1639 for (i = leni - 1; i >= 0; i--)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1640 args[i + i] = args[i];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1641
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1642 for (i = 1; i < nargs; i += 2)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1643 args[i] = separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1644
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1645 return Fconcat (nargs, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1646 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1647
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1648 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1649 "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
1650 The result is a list just as long as SEQUENCE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1651 SEQUENCE may be a list, a vector or a string.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1652 (function, sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1653 Lisp_Object function, sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1654 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1655 register Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1656 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1657 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1658
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1659 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1660 leni = XFASTINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1661 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1662
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1663 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1664
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1665 return Flist (leni, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1666 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1667
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1668 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1669
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1670 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
1671 "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
1672 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
1673 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
1674 No confirmation of the answer is requested; a single character is enough.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1675 Also accepts Space to mean yes, or Delete to mean no.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1676 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1677 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1678 {
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1679 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
1680 register int answer;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1681 Lisp_Object xprompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1682 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1683 struct gcpro gcpro1, gcpro2;
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1684 int count = specpdl_ptr - specpdl;
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1685
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1686 specbind (Qcursor_in_echo_area, Qt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1687
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1688 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
1689
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1691 xprompt = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1692 GCPRO2 (prompt, xprompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1693
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1694 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1695 {
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1696
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1697
13862
817ecef2d2d0 (Fy_or_n_p, Fyes_or_no_p): using_x_p renamed to have_menus_p.
Richard M. Stallman <rms@gnu.org>
parents: 13410
diff changeset
1698 #ifdef HAVE_MENUS
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
1699 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
13862
817ecef2d2d0 (Fy_or_n_p, Fyes_or_no_p): using_x_p renamed to have_menus_p.
Richard M. Stallman <rms@gnu.org>
parents: 13410
diff changeset
1700 && have_menus_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
1701 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1702 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
1703 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
1704 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
1705 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
1706 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
1707 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
1708 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
1709 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
1710 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
1711 }
13862
817ecef2d2d0 (Fy_or_n_p, Fyes_or_no_p): using_x_p renamed to have_menus_p.
Richard M. Stallman <rms@gnu.org>
parents: 13410
diff changeset
1712 #endif /* HAVE_MENUS */
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1713 cursor_in_echo_area = 1;
14392
127c6142a07a (Fy_or_n_p): Call choose_minibuf_frame.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1714 choose_minibuf_frame ();
11194
ca5effbebf81 (Fy_or_n_p): Don't log prompt.
Karl Heuer <kwzh@gnu.org>
parents: 11142
diff changeset
1715 message_nolog ("%s(y or n) ", XSTRING (xprompt)->data);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1716
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1717 if (minibuffer_auto_raise)
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1718 {
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1719 Lisp_Object mini_frame;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1720
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1721 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1722
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1723 Fraise_frame (mini_frame);
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1724 }
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
1725
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
1726 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
1727 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
1728 /* 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
1729 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
1730
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1731 key = Fmake_vector (make_number (1), obj);
15713
27487191083d (Fy_or_n_p): Pass 3rd arg to Flookup_key.
Karl Heuer <kwzh@gnu.org>
parents: 14617
diff changeset
1732 def = Flookup_key (map, key, Qt);
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1733 answer_string = Fsingle_key_description (obj);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1734
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1735 if (EQ (def, intern ("skip")))
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1736 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1737 answer = 0;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1738 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1739 }
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1740 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
1741 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1742 answer = 1;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1743 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1744 }
2311
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1745 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
1746 {
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1747 Frecenter (Qnil);
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1748 xprompt = prompt;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1749 continue;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
1750 }
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1751 else if (EQ (def, intern ("quit")))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1752 Vquit_flag = Qt;
10059
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
1753 /* We want to exit this command for exit-prefix,
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
1754 and this is the only way to do it. */
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
1755 else if (EQ (def, intern ("exit-prefix")))
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
1756 Vquit_flag = Qt;
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1757
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1758 QUIT;
1194
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
1759
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
1760 /* 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
1761 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
1762 Vquit_flag = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1763
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1766 if (EQ (xprompt, prompt))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1768 args[0] = build_string ("Please answer y or n. ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1769 args[1] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1770 xprompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1771 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1772 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1773 UNGCPRO;
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
1774
2525
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1775 if (! noninteractive)
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1776 {
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1777 cursor_in_echo_area = -1;
11194
ca5effbebf81 (Fy_or_n_p): Don't log prompt.
Karl Heuer <kwzh@gnu.org>
parents: 11142
diff changeset
1778 message_nolog ("%s(y or n) %c",
ca5effbebf81 (Fy_or_n_p): Don't log prompt.
Karl Heuer <kwzh@gnu.org>
parents: 11142
diff changeset
1779 XSTRING (xprompt)->data, answer ? 'y' : 'n');
2525
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
1780 }
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
1781
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1782 unbind_to (count, Qnil);
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
1783 return answer ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1784 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1785
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1786 /* 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
1787 to redefined it.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1788
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1789 Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1790
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792 do_yes_or_no_p (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1793 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1794 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1795 return call1 (intern ("yes-or-no-p"), prompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1797
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1798 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1799
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1800 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
1801 "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
1802 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
1803 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
1804 The user must confirm the answer with RET,\n\
11194
ca5effbebf81 (Fy_or_n_p): Don't log prompt.
Karl Heuer <kwzh@gnu.org>
parents: 11142
diff changeset
1805 and can edit it until it has been confirmed.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1806 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1807 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1808 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1809 register Lisp_Object ans;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1810 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1811 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
1812 Lisp_Object menu;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1813
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1814 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1815
13862
817ecef2d2d0 (Fy_or_n_p, Fyes_or_no_p): using_x_p renamed to have_menus_p.
Richard M. Stallman <rms@gnu.org>
parents: 13410
diff changeset
1816 #ifdef HAVE_MENUS
13410
7007664d3367 [HAVE_NTGUI] (Fy_or_n_p, Fyes_or_no_p): Allow popup.
Geoff Voelker <voelker@cs.washington.edu>
parents: 13363
diff changeset
1817 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
13862
817ecef2d2d0 (Fy_or_n_p, Fyes_or_no_p): using_x_p renamed to have_menus_p.
Richard M. Stallman <rms@gnu.org>
parents: 13410
diff changeset
1818 && have_menus_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
1819 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
1820 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
1821 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
1822 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
1823 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
1824 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
1825 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
1826 menu = Fcons (prompt, pane);
6344
4ef6b636dc99 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 6303
diff changeset
1827 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
1828 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
1829 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
1830 }
13862
817ecef2d2d0 (Fy_or_n_p, Fyes_or_no_p): using_x_p renamed to have_menus_p.
Richard M. Stallman <rms@gnu.org>
parents: 13410
diff changeset
1831 #endif /* HAVE_MENUS */
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
1832
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1833 args[0] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1834 args[1] = build_string ("(yes or no) ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1835 prompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1836
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1837 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
1838
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1839 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1840 {
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
1841 ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
1842 Qyes_or_no_p_history, Qnil));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1843 if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1844 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1845 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1846 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1847 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1848 if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1849 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1850 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1851 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1852 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1853
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1854 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1855 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1856 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
1857 Fsleep_for (make_number (2), Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1858 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1859 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1860
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1861 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1862 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1863 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
1864 then converted to integer.\n\
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1865 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
1866 shortened list, containing only those averages which are available.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1867 ()
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1868 {
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1869 double load_ave[3];
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1870 int loads = getloadavg (load_ave, 3);
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1871 Lisp_Object ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1872
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1873 if (loads < 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1874 error ("load-average not implemented for this operating system");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1875
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1876 ret = Qnil;
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1877 while (loads > 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1878 ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1879
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
1880 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1881 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1882
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1883 Lisp_Object Vfeatures;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1884
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1885 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1886 "Returns t if FEATURE is present in this Emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1887 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
1888 absence of emacs or environment extensions.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1889 Use `provide' to declare that a feature is available.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1890 This function looks at the value of the variable `features'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1891 (feature)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1892 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1893 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1894 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1895 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1896 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1897 return (NILP (tem)) ? Qnil : Qt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1898 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1899
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1900 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1901 "Announce that FEATURE is a feature of the current Emacs.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1902 (feature)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1903 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1904 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1905 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1906 CHECK_SYMBOL (feature, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1907 if (!NILP (Vautoload_queue))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1908 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1909 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1910 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1911 Vfeatures = Fcons (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1912 LOADHIST_ATTACH (Fcons (Qprovide, feature));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1913 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1914 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1915
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1916 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1917 "If feature FEATURE is not loaded, load it from FILENAME.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1918 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
1919 is not loaded; so load the file FILENAME.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1920 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
1921 (feature, file_name)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1922 Lisp_Object feature, file_name;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1923 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1924 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1925 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1926 tem = Fmemq (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1927 LOADHIST_ATTACH (Fcons (Qrequire, feature));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1928 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1929 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1930 int count = specpdl_ptr - specpdl;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1931
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1932 /* Value saved here is to be restored into Vautoload_queue */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1933 record_unwind_protect (un_autoload, Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1934 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1935
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1936 Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1937 Qnil, Qt, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1938
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1939 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1940 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 error ("Required feature %s was not provided",
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1942 XSYMBOL (feature)->name->data );
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1943
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1944 /* Once loading finishes, don't undo it. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1945 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1946 feature = unbind_to (count, feature);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1947 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1948 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1949 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1950
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1951 syms_of_fns ()
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 Qstring_lessp = intern ("string-lessp");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1954 staticpro (&Qstring_lessp);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1955 Qprovide = intern ("provide");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1956 staticpro (&Qprovide);
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1957 Qrequire = intern ("require");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
1958 staticpro (&Qrequire);
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
1959 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
1960 staticpro (&Qyes_or_no_p_history);
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1961 Qcursor_in_echo_area = intern ("cursor-in-echo-area");
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
1962 staticpro (&Qcursor_in_echo_area);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1963
14486
3c4ba112108e (syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents: 14456
diff changeset
1964 Fset (Qyes_or_no_p_history, Qnil);
3c4ba112108e (syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents: 14456
diff changeset
1965
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1966 DEFVAR_LISP ("features", &Vfeatures,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1967 "A list of symbols which are the features of the executing emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1968 Used by `featurep' and `require', and altered by `provide'.");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1969 Vfeatures = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1970
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1971 defsubr (&Sidentity);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1972 defsubr (&Srandom);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1973 defsubr (&Slength);
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
1974 defsubr (&Ssafe_length);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 defsubr (&Sstring_equal);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1976 defsubr (&Sstring_lessp);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1977 defsubr (&Sappend);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1978 defsubr (&Sconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1979 defsubr (&Svconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1980 defsubr (&Scopy_sequence);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1981 defsubr (&Scopy_alist);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1982 defsubr (&Ssubstring);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1983 defsubr (&Snthcdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1984 defsubr (&Snth);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1985 defsubr (&Selt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1986 defsubr (&Smember);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1987 defsubr (&Smemq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1988 defsubr (&Sassq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1989 defsubr (&Sassoc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1990 defsubr (&Srassq);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1991 defsubr (&Srassoc);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1992 defsubr (&Sdelq);
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
1993 defsubr (&Sdelete);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1994 defsubr (&Snreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1995 defsubr (&Sreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1996 defsubr (&Ssort);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1997 defsubr (&Splist_get);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1998 defsubr (&Sget);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1999 defsubr (&Splist_put);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2000 defsubr (&Sput);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2001 defsubr (&Sequal);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2002 defsubr (&Sfillarray);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2003 defsubr (&Schar_table_subtype);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2004 defsubr (&Schar_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2005 defsubr (&Sset_char_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2006 defsubr (&Schar_table_extra_slot);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2007 defsubr (&Sset_char_table_extra_slot);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2008 defsubr (&Schar_table_range);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2009 defsubr (&Sset_char_table_range);
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2010 defsubr (&Sset_char_table_default);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2011 defsubr (&Smap_char_table);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012 defsubr (&Snconc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013 defsubr (&Smapcar);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2014 defsubr (&Smapconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2015 defsubr (&Sy_or_n_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2016 defsubr (&Syes_or_no_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2017 defsubr (&Sload_average);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2018 defsubr (&Sfeaturep);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2019 defsubr (&Srequire);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2020 defsubr (&Sprovide);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2021 }