Mercurial > emacs
annotate src/fns.c @ 20639:12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 12 Jan 1998 05:49:45 +0000 |
parents | 04a436e5760b |
children | 64af046211eb |
rev | line source |
---|---|
211 | 1 /* Random utility Lisp functions. |
20567
d56b7d5c18e8
(internal_equal): For markers, use bytepos instead of bufpos.
Richard M. Stallman <rms@gnu.org>
parents:
20314
diff
changeset
|
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 1997 Free Software Foundation, Inc. |
211 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
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 | 9 any later version. |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
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 | 20 |
21 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4616
diff
changeset
|
22 #include <config.h> |
211 | 23 |
24 /* Note on some machines this defines `vector' as a typedef, | |
25 so make sure we don't use that name in this file. */ | |
26 #undef vector | |
27 #define vector ***** | |
28 | |
29 #include "lisp.h" | |
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 | 32 |
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 | 38 |
12062 | 39 #ifndef NULL |
40 #define NULL (void *)0 | |
41 #endif | |
42 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
43 /* Nonzero enables use of dialog boxes for questions |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
44 asked by mouse commands. */ |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
45 int use_dialog_box; |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
46 |
8901
ab65a3dae221
(Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents:
8388
diff
changeset
|
47 extern Lisp_Object Flookup_key (); |
ab65a3dae221
(Frandom): Fix Lisp_Object vs. int problems.
Karl Heuer <kwzh@gnu.org>
parents:
8388
diff
changeset
|
48 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
49 extern int minibuffer_auto_raise; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
50 extern Lisp_Object minibuf_window; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
51 |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
52 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
|
53 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
|
54 Lisp_Object Qcursor_in_echo_area; |
20004 | 55 Lisp_Object Qwidget_type; |
211 | 56 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
57 static int internal_equal (); |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
58 |
211 | 59 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
60 "Return the argument unchanged.") | |
61 (arg) | |
62 Lisp_Object arg; | |
63 { | |
64 return arg; | |
65 } | |
66 | |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
67 extern long get_random (); |
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
68 extern void seed_random (); |
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
69 extern long time (); |
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
70 |
211 | 71 DEFUN ("random", Frandom, Srandom, 0, 1, 0, |
72 "Return a pseudo-random number.\n\ | |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
73 All integers representable in Lisp are equally likely.\n\ |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
74 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
|
75 With positive integer argument N, return random number in interval [0,N).\n\ |
211 | 76 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
|
77 (n) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
78 Lisp_Object n; |
211 | 79 { |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
80 EMACS_INT val; |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
81 Lisp_Object lispy_val; |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
82 unsigned long denominator; |
211 | 83 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
84 if (EQ (n, Qt)) |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
85 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
|
86 if (NATNUMP (n) && XFASTINT (n) != 0) |
211 | 87 { |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
88 /* 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
|
89 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
|
90 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
|
91 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
|
92 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
|
93 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
|
94 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
|
95 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
96 do |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
97 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
|
98 while (val >= XFASTINT (n)); |
211 | 99 } |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
100 else |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
101 val = get_random (); |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
102 XSETINT (lispy_val, val); |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
103 return lispy_val; |
211 | 104 } |
105 | |
106 /* Random data-structure functions */ | |
107 | |
108 DEFUN ("length", Flength, Slength, 1, 1, 0, | |
109 "Return the length of vector, list or string SEQUENCE.\n\ | |
19383 | 110 A byte-code function object is also allowed.\n\ |
111 If the string contains multibyte characters, this is not the necessarily\n\ | |
112 the number of characters in the string; it is the number of bytes.\n\ | |
113 To get the number of characters, use `chars-in-string'") | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
114 (sequence) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
115 register Lisp_Object sequence; |
211 | 116 { |
117 register Lisp_Object tail, val; | |
118 register int i; | |
119 | |
120 retry: | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
121 if (STRINGP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
122 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
|
123 else if (VECTORP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
124 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
|
125 else if (CHAR_TABLE_P (sequence)) |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
126 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
|
127 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
|
128 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
|
129 else if (COMPILEDP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
130 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
|
131 else if (CONSP (sequence)) |
211 | 132 { |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
133 for (i = 0, tail = sequence; !NILP (tail); i++) |
211 | 134 { |
135 QUIT; | |
136 tail = Fcdr (tail); | |
137 } | |
138 | |
9308
2c594629baaa
(Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9289
diff
changeset
|
139 XSETFASTINT (val, i); |
211 | 140 } |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
141 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
|
142 XSETFASTINT (val, 0); |
211 | 143 else |
144 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
145 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 146 goto retry; |
147 } | |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
148 return val; |
211 | 149 } |
150 | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
151 /* This does not check for quits. That is safe |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
152 since it must terminate. */ |
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 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
|
155 "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
|
156 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
|
157 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
|
158 which is at least the number of distinct elements.") |
20004 | 159 (list) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
160 Lisp_Object list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
161 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
162 Lisp_Object tail, halftail, length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
163 int len = 0; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
164 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
165 /* halftail is used to detect circular lists. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
166 halftail = list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
167 for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
168 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
169 if (EQ (tail, halftail) && len != 0) |
12618
60c4c0fee545
(Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents:
12466
diff
changeset
|
170 break; |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
171 len++; |
13344
30e17254a280
(Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents:
13277
diff
changeset
|
172 if ((len & 1) == 0) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
173 halftail = XCONS (halftail)->cdr; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
174 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
175 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
176 XSETINT (length, len); |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
177 return length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
178 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
179 |
211 | 180 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0, |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
181 "Return 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
|
182 Case is significant, but text properties are ignored.\n\ |
211 | 183 Symbols are also allowed; their print names are used instead.") |
184 (s1, s2) | |
185 register Lisp_Object s1, s2; | |
186 { | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
187 if (SYMBOLP (s1)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
188 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
|
189 if (SYMBOLP (s2)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
190 XSETSTRING (s2, XSYMBOL (s2)->name); |
211 | 191 CHECK_STRING (s1, 0); |
192 CHECK_STRING (s2, 1); | |
193 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
194 if (XSTRING (s1)->size != XSTRING (s2)->size |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
195 || XSTRING (s1)->size_byte != XSTRING (s2)->size_byte |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
196 || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size_byte)) |
211 | 197 return Qnil; |
198 return Qt; | |
199 } | |
200 | |
201 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
202 "Return t if first arg string is less than second in lexicographic order.\n\ |
211 | 203 Case is significant.\n\ |
204 Symbols are also allowed; their print names are used instead.") | |
205 (s1, s2) | |
206 register Lisp_Object s1, s2; | |
207 { | |
208 register int i; | |
209 register unsigned char *p1, *p2; | |
210 register int end; | |
211 | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
212 if (SYMBOLP (s1)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
213 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
|
214 if (SYMBOLP (s2)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
215 XSETSTRING (s2, XSYMBOL (s2)->name); |
211 | 216 CHECK_STRING (s1, 0); |
217 CHECK_STRING (s2, 1); | |
218 | |
219 p1 = XSTRING (s1)->data; | |
220 p2 = XSTRING (s2)->data; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
221 end = XSTRING (s1)->size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
222 if (end > XSTRING (s2)->size_byte) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
223 end = XSTRING (s2)->size_byte; |
211 | 224 |
225 for (i = 0; i < end; i++) | |
226 { | |
227 if (p1[i] != p2[i]) | |
228 return p1[i] < p2[i] ? Qt : Qnil; | |
229 } | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
230 return i < XSTRING (s2)->size_byte ? Qt : Qnil; |
211 | 231 } |
232 | |
233 static Lisp_Object concat (); | |
234 | |
235 /* ARGSUSED */ | |
236 Lisp_Object | |
237 concat2 (s1, s2) | |
238 Lisp_Object s1, s2; | |
239 { | |
240 #ifdef NO_ARG_ARRAY | |
241 Lisp_Object args[2]; | |
242 args[0] = s1; | |
243 args[1] = s2; | |
244 return concat (2, args, Lisp_String, 0); | |
245 #else | |
246 return concat (2, &s1, Lisp_String, 0); | |
247 #endif /* NO_ARG_ARRAY */ | |
248 } | |
249 | |
8966
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
250 /* ARGSUSED */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
251 Lisp_Object |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
252 concat3 (s1, s2, s3) |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
253 Lisp_Object s1, s2, s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
254 { |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
255 #ifdef NO_ARG_ARRAY |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
256 Lisp_Object args[3]; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
257 args[0] = s1; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
258 args[1] = s2; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
259 args[2] = s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
260 return concat (3, args, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
261 #else |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
262 return concat (3, &s1, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
263 #endif /* NO_ARG_ARRAY */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
264 } |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
265 |
211 | 266 DEFUN ("append", Fappend, Sappend, 0, MANY, 0, |
267 "Concatenate all the arguments and make the result a list.\n\ | |
268 The result is a list whose elements are the elements of all the arguments.\n\ | |
269 Each argument may be a list, vector or string.\n\ | |
1037 | 270 The last argument is not copied, just used as the tail of the new list.") |
211 | 271 (nargs, args) |
272 int nargs; | |
273 Lisp_Object *args; | |
274 { | |
275 return concat (nargs, args, Lisp_Cons, 1); | |
276 } | |
277 | |
278 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, | |
279 "Concatenate all the arguments and make the result a string.\n\ | |
280 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
|
281 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
|
282 \n\ |
41b869bbe0e1
(Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
11138
diff
changeset
|
283 Do not use individual integers as arguments!\n\ |
41b869bbe0e1
(Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
11138
diff
changeset
|
284 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
|
285 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
|
286 you should change it right away not to do so.") |
211 | 287 (nargs, args) |
288 int nargs; | |
289 Lisp_Object *args; | |
290 { | |
291 return concat (nargs, args, Lisp_String, 0); | |
292 } | |
293 | |
294 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, | |
295 "Concatenate all the arguments and make the result a vector.\n\ | |
296 The result is a vector whose elements are the elements of all the arguments.\n\ | |
297 Each argument may be a list, vector or string.") | |
298 (nargs, args) | |
299 int nargs; | |
300 Lisp_Object *args; | |
301 { | |
10006
402c87cbc4fa
(Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9965
diff
changeset
|
302 return concat (nargs, args, Lisp_Vectorlike, 0); |
211 | 303 } |
304 | |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
305 /* 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
|
306 nested sub char table are not copied. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
307 static Lisp_Object |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
308 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
|
309 Lisp_Object arg; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
310 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
311 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
|
312 int 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 /* Copy all the contents. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
315 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
|
316 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
317 /* 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
|
318 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
|
319 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
|
320 XCHAR_TABLE (copy)->contents[i] |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
321 = 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
|
322 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
323 return copy; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
324 } |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
325 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
326 |
211 | 327 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, |
328 "Return a copy of a list, vector or string.\n\ | |
329 The elements of a list or vector are not copied; they are shared\n\ | |
330 with the original.") | |
331 (arg) | |
332 Lisp_Object arg; | |
333 { | |
485 | 334 if (NILP (arg)) return arg; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
335 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
336 if (CHAR_TABLE_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
337 { |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
338 int i; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
339 Lisp_Object copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
340 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
341 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
|
342 /* 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
|
343 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
344 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) |
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
345 * sizeof (Lisp_Object))); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
346 |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
347 /* 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
|
348 for multibyte characters. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
349 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
350 i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
351 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
|
352 XCHAR_TABLE (copy)->contents[i] |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
353 = 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
|
354 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
355 return copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
356 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
357 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
358 if (BOOL_VECTOR_P (arg)) |
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 Lisp_Object val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
361 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
362 = (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
|
363 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
364 val = Fmake_bool_vector (Flength (arg), Qnil); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
365 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
|
366 size_in_chars); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
367 return val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
368 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
369 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
370 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) |
211 | 371 arg = wrong_type_argument (Qsequencep, arg); |
372 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); | |
373 } | |
374 | |
375 static Lisp_Object | |
376 concat (nargs, args, target_type, last_special) | |
377 int nargs; | |
378 Lisp_Object *args; | |
379 enum Lisp_Type target_type; | |
380 int last_special; | |
381 { | |
382 Lisp_Object val; | |
383 register Lisp_Object tail; | |
384 register Lisp_Object this; | |
385 int toindex; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
386 int toindex_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
387 register int result_len; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
388 register int result_len_byte; |
211 | 389 register int argnum; |
390 Lisp_Object last_tail; | |
391 Lisp_Object prev; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
392 int some_multibyte; |
211 | 393 |
394 /* In append, the last arg isn't treated like the others */ | |
395 if (last_special && nargs > 0) | |
396 { | |
397 nargs--; | |
398 last_tail = args[nargs]; | |
399 } | |
400 else | |
401 last_tail = Qnil; | |
402 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
403 /* Canonicalize each argument. */ |
211 | 404 for (argnum = 0; argnum < nargs; argnum++) |
405 { | |
406 this = args[argnum]; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
407 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
|
408 || COMPILEDP (this) || BOOL_VECTOR_P (this))) |
211 | 409 { |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
410 if (INTEGERP (this)) |
11142
41b869bbe0e1
(Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
11138
diff
changeset
|
411 args[argnum] = Fnumber_to_string (this); |
211 | 412 else |
413 args[argnum] = wrong_type_argument (Qsequencep, this); | |
414 } | |
415 } | |
416 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
417 /* Compute total length in chars of arguments in RESULT_LEN. |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
418 If desired output is a string, also compute length in bytes |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
419 in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
420 whether the result should be a multibyte string. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
421 result_len_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
422 result_len = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
423 some_multibyte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
424 for (argnum = 0; argnum < nargs; argnum++) |
211 | 425 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
426 int len; |
211 | 427 this = args[argnum]; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
428 len = XFASTINT (Flength (this)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
429 if (target_type == Lisp_String) |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
430 { |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
431 /* We must pay attention to a multibyte character which |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
432 takes more than one byte in string. */ |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
433 int i; |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
434 Lisp_Object ch; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
435 int this_len_byte; |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
436 |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
437 if (VECTORP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
438 for (i = 0; i < len; i++) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
439 { |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
440 ch = XVECTOR (this)->contents[i]; |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
441 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
442 wrong_type_argument (Qintegerp, ch); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
443 this_len_byte = XFASTINT (Fchar_bytes (ch)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
444 result_len_byte += this_len_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
445 if (this_len_byte > 1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
446 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
447 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
448 else if (CONSP (this)) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
449 for (; CONSP (this); this = XCONS (this)->cdr) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
450 { |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
451 ch = XCONS (this)->car; |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
452 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
453 wrong_type_argument (Qintegerp, ch); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
454 this_len_byte = XFASTINT (Fchar_bytes (ch)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
455 result_len_byte += this_len_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
456 if (this_len_byte > 1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
457 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
458 } |
20639
12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents:
20607
diff
changeset
|
459 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
460 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
461 result_len_byte += XSTRING (this)->size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
462 if (STRING_MULTIBYTE (this)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
463 some_multibyte = 1; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
464 } |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
465 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
466 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
467 result_len += len; |
211 | 468 } |
469 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
470 /* In `append', if all but last arg are nil, return last arg. */ |
211 | 471 if (target_type == Lisp_Cons && EQ (val, Qnil)) |
472 return last_tail; | |
473 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
474 /* Create the output object. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
475 if (target_type == Lisp_Cons) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
476 val = Fmake_list (make_number (result_len), Qnil); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
477 else if (target_type == Lisp_Vectorlike) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
478 val = Fmake_vector (make_number (result_len), Qnil); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
479 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
480 val = make_uninit_multibyte_string (result_len, result_len_byte); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
481 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
482 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
483 /* Copy the contents of the args into the result. */ |
211 | 484 if (CONSP (val)) |
485 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ | |
486 else | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
487 toindex = 0, toindex_byte = 0; |
211 | 488 |
489 prev = Qnil; | |
490 | |
491 for (argnum = 0; argnum < nargs; argnum++) | |
492 { | |
493 Lisp_Object thislen; | |
494 int thisleni; | |
16863
591b7a95d7a5
(concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents:
16561
diff
changeset
|
495 register unsigned int thisindex = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
496 register unsigned int thisindex_byte = 0; |
211 | 497 |
498 this = args[argnum]; | |
499 if (!CONSP (this)) | |
500 thislen = Flength (this), thisleni = XINT (thislen); | |
501 | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
502 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
|
503 && ! NULL_INTERVAL_P (XSTRING (this)->intervals)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
504 copy_text_properties (make_number (0), thislen, this, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
505 make_number (toindex), val, Qnil); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
506 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
507 /* Between strings of the same kind, copy fast. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
508 if (STRINGP (this) && STRINGP (val) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
509 && STRING_MULTIBYTE (this) == some_multibyte) |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
510 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
511 int thislen_byte = XSTRING (this)->size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
512 bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
513 XSTRING (this)->size_byte); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
514 toindex_byte += thislen_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
515 toindex += thisleni; |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
516 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
517 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
518 /* Copy element by element. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
519 while (1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
520 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
521 register Lisp_Object elt; |
211 | 522 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
523 /* Fetch next element of `this' arg into `elt', or break if |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
524 `this' is exhausted. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
525 if (NILP (this)) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
526 if (CONSP (this)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
527 elt = XCONS (this)->car, this = XCONS (this)->cdr; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
528 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
529 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
530 if (thisindex >= thisleni) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
531 if (STRINGP (this)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
532 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
533 if (STRING_MULTIBYTE (this)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
534 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
535 int c; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
536 FETCH_STRING_CHAR_ADVANCE (c, this, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
537 thisindex, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
538 thisindex_byte); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
539 XSETFASTINT (elt, c); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
540 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
541 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
542 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
543 unsigned char c; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
544 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
545 if (some_multibyte && XINT (elt) >= 0200 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
546 && XINT (elt) < 0400) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
547 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
548 c = XINT (elt); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
549 copy_text (&c, &c, 1, 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
550 XSETINT (elt, c); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
551 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
552 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
553 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
554 else if (BOOL_VECTOR_P (this)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
555 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
556 int size_in_chars |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
557 = ((XBOOL_VECTOR (this)->size + BITS_PER_CHAR - 1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
558 / BITS_PER_CHAR); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
559 int byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
560 byte = XBOOL_VECTOR (val)->data[thisindex / BITS_PER_CHAR]; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
561 if (byte & (1 << (thisindex % BITS_PER_CHAR))) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
562 elt = Qt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
563 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
564 elt = Qnil; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
565 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
566 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
567 elt = XVECTOR (this)->contents[thisindex++]; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
568 } |
211 | 569 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
570 /* Store this element into the result. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
571 if (toindex < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
572 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
573 XCONS (tail)->car = elt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
574 prev = tail; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
575 tail = XCONS (tail)->cdr; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
576 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
577 else if (VECTORP (val)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
578 XVECTOR (val)->contents[toindex++] = elt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
579 else |
211 | 580 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
581 CHECK_NUMBER (elt, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
582 if (SINGLE_BYTE_CHAR_P (XINT (elt))) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
583 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
584 XSTRING (val)->data[toindex++] = XINT (elt); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
585 toindex_byte++; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
586 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
587 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
588 /* If we have any multibyte characters, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
589 we already decided to make a multibyte string. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
590 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
591 int c = XINT (elt); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
592 unsigned char work[4], *str; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
593 int i = CHAR_STRING (c, work, str); |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
594 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
595 /* P exists as a variable |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
596 to avoid a bug on the Masscomp C compiler. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
597 unsigned char *p = & XSTRING (val)->data[toindex_byte]; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
598 bcopy (str, p, i); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
599 toindex_byte += i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
600 toindex++; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
601 } |
211 | 602 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
603 } |
211 | 604 } |
485 | 605 if (!NILP (prev)) |
211 | 606 XCONS (prev)->cdr = last_tail; |
607 | |
20004 | 608 return val; |
211 | 609 } |
610 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
611 /* Return the character index corresponding to CHAR_INDEX in STRING. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
612 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
613 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
614 string_char_to_byte (string, char_index) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
615 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
616 int char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
617 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
618 int i = 0, i_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
619 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
620 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
621 return char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
622 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
623 while (i < char_index) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
624 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
625 int c; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
626 FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
627 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
628 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
629 return i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
630 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
631 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
632 /* Return the character index corresponding to BYTE_INDEX in STRING. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
633 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
634 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
635 string_byte_to_char (string, byte_index) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
636 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
637 int byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
638 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
639 int i = 0, i_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
640 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
641 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
642 return byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
643 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
644 while (i_byte < byte_index) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
645 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
646 int c; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
647 FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
648 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
649 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
650 return i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
651 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
652 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
653 /* Convert STRING to a multibyte string. |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
654 Single-byte characters 0200 through 0377 are converted |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
655 by adding nonascii_insert_offset to each. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
656 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
657 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
658 string_make_multibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
659 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
660 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
661 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
662 int nbytes; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
663 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
664 if (STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
665 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
666 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
667 nbytes = count_size_as_multibyte (XSTRING (string)->data, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
668 XSTRING (string)->size); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
669 buf = (unsigned char *) alloca (nbytes); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
670 copy_text (XSTRING (string)->data, buf, XSTRING (string)->size_byte, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
671 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
672 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
673 return make_multibyte_string (buf, XSTRING (string)->size, nbytes); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
674 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
675 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
676 /* Convert STRING to a single-byte string. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
677 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
678 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
679 string_make_unibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
680 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
681 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
682 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
683 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
684 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
685 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
686 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
687 buf = (unsigned char *) alloca (XSTRING (string)->size); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
688 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
689 copy_text (XSTRING (string)->data, buf, XSTRING (string)->size_byte, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
690 1, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
691 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
692 return make_unibyte_string (buf, XSTRING (string)->size); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
693 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
694 |
211 | 695 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0, |
696 "Return a copy of ALIST.\n\ | |
697 This is an alist which represents the same mapping from objects to objects,\n\ | |
698 but does not share the alist structure with ALIST.\n\ | |
699 The objects mapped (cars and cdrs of elements of the alist)\n\ | |
700 are shared, however.\n\ | |
701 Elements of ALIST that are not conses are also shared.") | |
702 (alist) | |
703 Lisp_Object alist; | |
704 { | |
705 register Lisp_Object tem; | |
706 | |
707 CHECK_LIST (alist, 0); | |
485 | 708 if (NILP (alist)) |
211 | 709 return alist; |
710 alist = concat (1, &alist, Lisp_Cons, 0); | |
711 for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr) | |
712 { | |
713 register Lisp_Object car; | |
714 car = XCONS (tem)->car; | |
715 | |
716 if (CONSP (car)) | |
717 XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr); | |
718 } | |
719 return alist; | |
720 } | |
721 | |
722 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, | |
723 "Return a substring of STRING, starting at index FROM and ending before TO.\n\ | |
724 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
|
725 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
|
726 \n\ |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
727 This function allows vectors as well as strings.") |
211 | 728 (string, from, to) |
729 Lisp_Object string; | |
730 register Lisp_Object from, to; | |
731 { | |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
732 Lisp_Object res; |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
733 int size; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
734 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
735 int from_char, to_char; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
736 int from_byte, to_byte; |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
737 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
738 if (! (STRINGP (string) || VECTORP (string))) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
739 wrong_type_argument (Qarrayp, string); |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
740 |
211 | 741 CHECK_NUMBER (from, 1); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
742 |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
743 if (STRINGP (string)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
744 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
745 size = XSTRING (string)->size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
746 size_byte = XSTRING (string)->size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
747 } |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
748 else |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
749 size = XVECTOR (string)->size; |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
750 |
485 | 751 if (NILP (to)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
752 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
753 to_char = size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
754 to_byte = size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
755 } |
211 | 756 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
757 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
758 CHECK_NUMBER (to, 2); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
759 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
760 to_char = XINT (to); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
761 if (to_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
762 to_char += size; |
211 | 763 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
764 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
765 to_byte = string_char_to_byte (string, to_char); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
766 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
767 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
768 from_char = XINT (from); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
769 if (from_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
770 from_char += size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
771 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
772 from_byte = string_char_to_byte (string, from_char); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
773 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
774 if (!(0 <= from_char && from_char <= to_char && to_char <= size)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
775 args_out_of_range_3 (string, make_number (from_char), |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
776 make_number (to_char)); |
211 | 777 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
778 if (STRINGP (string)) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
779 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
780 res = make_multibyte_string (XSTRING (string)->data + from_byte, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
781 to_char - from_char, to_byte - from_byte); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
782 copy_text_properties (from_char, to_char, string, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
783 make_number (0), res, Qnil); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
784 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
785 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
786 res = Fvector (to_char - from_char, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
787 XVECTOR (string)->contents + from_char); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
788 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
789 return res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
790 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
791 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
792 /* Extract a substring of STRING, giving start and end positions |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
793 both in characters and in bytes. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
794 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
795 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
796 substring_both (string, from, from_byte, to, to_byte) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
797 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
798 int from, from_byte, to, to_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
799 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
800 Lisp_Object res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
801 int size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
802 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
803 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
804 if (! (STRINGP (string) || VECTORP (string))) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
805 wrong_type_argument (Qarrayp, string); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
806 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
807 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
808 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
809 size = XSTRING (string)->size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
810 size_byte = XSTRING (string)->size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
811 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
812 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
813 size = XVECTOR (string)->size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
814 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
815 if (!(0 <= from && from <= to && to <= size)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
816 args_out_of_range_3 (string, make_number (from), make_number (to)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
817 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
818 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
819 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
820 res = make_multibyte_string (XSTRING (string)->data + from_byte, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
821 to - from, to_byte - from_byte); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
822 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
|
823 } |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
824 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
825 res = Fvector (to - from, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
826 XVECTOR (string)->contents + from); |
20004 | 827 |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
828 return res; |
211 | 829 } |
830 | |
831 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, | |
832 "Take cdr N times on LIST, returns the result.") | |
833 (n, list) | |
834 Lisp_Object n; | |
835 register Lisp_Object list; | |
836 { | |
837 register int i, num; | |
838 CHECK_NUMBER (n, 0); | |
839 num = XINT (n); | |
485 | 840 for (i = 0; i < num && !NILP (list); i++) |
211 | 841 { |
842 QUIT; | |
843 list = Fcdr (list); | |
844 } | |
845 return list; | |
846 } | |
847 | |
848 DEFUN ("nth", Fnth, Snth, 2, 2, 0, | |
849 "Return the Nth element of LIST.\n\ | |
850 N counts from zero. If LIST is not that long, nil is returned.") | |
851 (n, list) | |
852 Lisp_Object n, list; | |
853 { | |
854 return Fcar (Fnthcdr (n, list)); | |
855 } | |
856 | |
857 DEFUN ("elt", Felt, Selt, 2, 2, 0, | |
858 "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
|
859 (sequence, n) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
860 register Lisp_Object sequence, n; |
211 | 861 { |
862 CHECK_NUMBER (n, 0); | |
863 while (1) | |
864 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
865 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
|
866 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
|
867 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
|
868 || 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
|
869 return Faref (sequence, n); |
211 | 870 else |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
871 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 872 } |
873 } | |
874 | |
875 DEFUN ("member", Fmember, Smember, 2, 2, 0, | |
6990 | 876 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\ |
211 | 877 The value is actually the tail of LIST whose car is ELT.") |
878 (elt, list) | |
879 register Lisp_Object elt; | |
880 Lisp_Object list; | |
881 { | |
882 register Lisp_Object tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
883 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 884 { |
885 register Lisp_Object tem; | |
886 tem = Fcar (tail); | |
485 | 887 if (! NILP (Fequal (elt, tem))) |
211 | 888 return tail; |
889 QUIT; | |
890 } | |
891 return Qnil; | |
892 } | |
893 | |
894 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | |
895 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\ | |
896 The value is actually the tail of LIST whose car is ELT.") | |
897 (elt, list) | |
898 register Lisp_Object elt; | |
899 Lisp_Object list; | |
900 { | |
901 register Lisp_Object tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
902 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 903 { |
904 register Lisp_Object tem; | |
905 tem = Fcar (tail); | |
906 if (EQ (elt, tem)) return tail; | |
907 QUIT; | |
908 } | |
909 return Qnil; | |
910 } | |
911 | |
912 DEFUN ("assq", Fassq, Sassq, 2, 2, 0, | |
5661
066830a71a63
(Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
5437
diff
changeset
|
913 "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
|
914 The value is actually the element of LIST whose car is KEY.\n\ |
211 | 915 Elements of LIST that are not conses are ignored.") |
916 (key, list) | |
917 register Lisp_Object key; | |
918 Lisp_Object list; | |
919 { | |
920 register Lisp_Object tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
921 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 922 { |
923 register Lisp_Object elt, tem; | |
924 elt = Fcar (tail); | |
925 if (!CONSP (elt)) continue; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
926 tem = XCONS (elt)->car; |
211 | 927 if (EQ (key, tem)) return elt; |
928 QUIT; | |
929 } | |
930 return Qnil; | |
931 } | |
932 | |
933 /* Like Fassq but never report an error and do not allow quits. | |
934 Use only on lists known never to be circular. */ | |
935 | |
936 Lisp_Object | |
937 assq_no_quit (key, list) | |
938 register Lisp_Object key; | |
939 Lisp_Object list; | |
940 { | |
941 register Lisp_Object tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
942 for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) |
211 | 943 { |
944 register Lisp_Object elt, tem; | |
945 elt = Fcar (tail); | |
946 if (!CONSP (elt)) continue; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
947 tem = XCONS (elt)->car; |
211 | 948 if (EQ (key, tem)) return elt; |
949 } | |
950 return Qnil; | |
951 } | |
952 | |
953 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | |
5661
066830a71a63
(Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
5437
diff
changeset
|
954 "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
|
955 The value is actually the element of LIST whose car equals KEY.") |
211 | 956 (key, list) |
957 register Lisp_Object key; | |
958 Lisp_Object list; | |
959 { | |
960 register Lisp_Object tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
961 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 962 { |
963 register Lisp_Object elt, tem; | |
964 elt = Fcar (tail); | |
965 if (!CONSP (elt)) continue; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
966 tem = Fequal (XCONS (elt)->car, key); |
485 | 967 if (!NILP (tem)) return elt; |
211 | 968 QUIT; |
969 } | |
970 return Qnil; | |
971 } | |
972 | |
973 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, | |
974 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\ | |
975 The value is actually the element of LIST whose cdr is ELT.") | |
976 (key, list) | |
977 register Lisp_Object key; | |
978 Lisp_Object list; | |
979 { | |
980 register Lisp_Object tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
981 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 982 { |
983 register Lisp_Object elt, tem; | |
984 elt = Fcar (tail); | |
985 if (!CONSP (elt)) continue; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
986 tem = XCONS (elt)->cdr; |
211 | 987 if (EQ (key, tem)) return elt; |
988 QUIT; | |
989 } | |
990 return Qnil; | |
991 } | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
992 |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
993 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
994 "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
|
995 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
|
996 (key, list) |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
997 register Lisp_Object key; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
998 Lisp_Object list; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
999 { |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1000 register Lisp_Object tail; |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1001 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1002 { |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1003 register Lisp_Object elt, tem; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1004 elt = Fcar (tail); |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1005 if (!CONSP (elt)) continue; |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1006 tem = Fequal (XCONS (elt)->cdr, key); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1007 if (!NILP (tem)) return elt; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1008 QUIT; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1009 } |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1010 return Qnil; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1011 } |
211 | 1012 |
1013 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, | |
1014 "Delete by side effect any occurrences of ELT as a member of LIST.\n\ | |
1015 The modified LIST is returned. Comparison is done with `eq'.\n\ | |
1016 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\ | |
1017 therefore, write `(setq foo (delq element foo))'\n\ | |
1018 to be sure of changing the value of `foo'.") | |
1019 (elt, list) | |
1020 register Lisp_Object elt; | |
1021 Lisp_Object list; | |
1022 { | |
1023 register Lisp_Object tail, prev; | |
1024 register Lisp_Object tem; | |
1025 | |
1026 tail = list; | |
1027 prev = Qnil; | |
485 | 1028 while (!NILP (tail)) |
211 | 1029 { |
1030 tem = Fcar (tail); | |
1031 if (EQ (elt, tem)) | |
1032 { | |
485 | 1033 if (NILP (prev)) |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1034 list = XCONS (tail)->cdr; |
211 | 1035 else |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1036 Fsetcdr (prev, XCONS (tail)->cdr); |
211 | 1037 } |
1038 else | |
1039 prev = tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1040 tail = XCONS (tail)->cdr; |
211 | 1041 QUIT; |
1042 } | |
1043 return list; | |
1044 } | |
1045 | |
414 | 1046 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0, |
401 | 1047 "Delete by side effect any occurrences of ELT as a member of LIST.\n\ |
1048 The modified LIST is returned. Comparison is done with `equal'.\n\ | |
6990 | 1049 If the first member of LIST is ELT, deleting it is not a side effect;\n\ |
1050 it is simply using a different list.\n\ | |
1051 Therefore, write `(setq foo (delete element foo))'\n\ | |
401 | 1052 to be sure of changing the value of `foo'.") |
1053 (elt, list) | |
1054 register Lisp_Object elt; | |
1055 Lisp_Object list; | |
1056 { | |
1057 register Lisp_Object tail, prev; | |
1058 register Lisp_Object tem; | |
1059 | |
1060 tail = list; | |
1061 prev = Qnil; | |
485 | 1062 while (!NILP (tail)) |
401 | 1063 { |
1064 tem = Fcar (tail); | |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
1065 if (! NILP (Fequal (elt, tem))) |
401 | 1066 { |
485 | 1067 if (NILP (prev)) |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1068 list = XCONS (tail)->cdr; |
401 | 1069 else |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1070 Fsetcdr (prev, XCONS (tail)->cdr); |
401 | 1071 } |
1072 else | |
1073 prev = tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1074 tail = XCONS (tail)->cdr; |
401 | 1075 QUIT; |
1076 } | |
1077 return list; | |
1078 } | |
1079 | |
211 | 1080 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0, |
1081 "Reverse LIST by modifying cdr pointers.\n\ | |
1082 Returns the beginning of the reversed list.") | |
1083 (list) | |
1084 Lisp_Object list; | |
1085 { | |
1086 register Lisp_Object prev, tail, next; | |
1087 | |
485 | 1088 if (NILP (list)) return list; |
211 | 1089 prev = Qnil; |
1090 tail = list; | |
485 | 1091 while (!NILP (tail)) |
211 | 1092 { |
1093 QUIT; | |
1094 next = Fcdr (tail); | |
1095 Fsetcdr (tail, prev); | |
1096 prev = tail; | |
1097 tail = next; | |
1098 } | |
1099 return prev; | |
1100 } | |
1101 | |
1102 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, | |
1103 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\ | |
1104 See also the function `nreverse', which is used more often.") | |
1105 (list) | |
1106 Lisp_Object list; | |
1107 { | |
18421 | 1108 Lisp_Object new; |
211 | 1109 |
18421 | 1110 for (new = Qnil; CONSP (list); list = XCONS (list)->cdr) |
1111 new = Fcons (XCONS (list)->car, new); | |
1112 if (!NILP (list)) | |
1113 wrong_type_argument (Qconsp, list); | |
1114 return new; | |
211 | 1115 } |
1116 | |
1117 Lisp_Object merge (); | |
1118 | |
1119 DEFUN ("sort", Fsort, Ssort, 2, 2, 0, | |
1120 "Sort LIST, stably, comparing elements using PREDICATE.\n\ | |
1121 Returns the sorted list. LIST is modified by side effects.\n\ | |
1122 PREDICATE is called with two elements of LIST, and should return T\n\ | |
1123 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
|
1124 (list, predicate) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1125 Lisp_Object list, predicate; |
211 | 1126 { |
1127 Lisp_Object front, back; | |
1128 register Lisp_Object len, tem; | |
1129 struct gcpro gcpro1, gcpro2; | |
1130 register int length; | |
1131 | |
1132 front = list; | |
1133 len = Flength (list); | |
1134 length = XINT (len); | |
1135 if (length < 2) | |
1136 return list; | |
1137 | |
1138 XSETINT (len, (length / 2) - 1); | |
1139 tem = Fnthcdr (len, list); | |
1140 back = Fcdr (tem); | |
1141 Fsetcdr (tem, Qnil); | |
1142 | |
1143 GCPRO2 (front, back); | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1144 front = Fsort (front, predicate); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1145 back = Fsort (back, predicate); |
211 | 1146 UNGCPRO; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1147 return merge (front, back, predicate); |
211 | 1148 } |
1149 | |
1150 Lisp_Object | |
1151 merge (org_l1, org_l2, pred) | |
1152 Lisp_Object org_l1, org_l2; | |
1153 Lisp_Object pred; | |
1154 { | |
1155 Lisp_Object value; | |
1156 register Lisp_Object tail; | |
1157 Lisp_Object tem; | |
1158 register Lisp_Object l1, l2; | |
1159 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1160 | |
1161 l1 = org_l1; | |
1162 l2 = org_l2; | |
1163 tail = Qnil; | |
1164 value = Qnil; | |
1165 | |
1166 /* It is sufficient to protect org_l1 and org_l2. | |
1167 When l1 and l2 are updated, we copy the new values | |
1168 back into the org_ vars. */ | |
1169 GCPRO4 (org_l1, org_l2, pred, value); | |
1170 | |
1171 while (1) | |
1172 { | |
485 | 1173 if (NILP (l1)) |
211 | 1174 { |
1175 UNGCPRO; | |
485 | 1176 if (NILP (tail)) |
211 | 1177 return l2; |
1178 Fsetcdr (tail, l2); | |
1179 return value; | |
1180 } | |
485 | 1181 if (NILP (l2)) |
211 | 1182 { |
1183 UNGCPRO; | |
485 | 1184 if (NILP (tail)) |
211 | 1185 return l1; |
1186 Fsetcdr (tail, l1); | |
1187 return value; | |
1188 } | |
1189 tem = call2 (pred, Fcar (l2), Fcar (l1)); | |
485 | 1190 if (NILP (tem)) |
211 | 1191 { |
1192 tem = l1; | |
1193 l1 = Fcdr (l1); | |
1194 org_l1 = l1; | |
1195 } | |
1196 else | |
1197 { | |
1198 tem = l2; | |
1199 l2 = Fcdr (l2); | |
1200 org_l2 = l2; | |
1201 } | |
485 | 1202 if (NILP (tail)) |
211 | 1203 value = tem; |
1204 else | |
1205 Fsetcdr (tail, tem); | |
1206 tail = tem; | |
1207 } | |
1208 } | |
1209 | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1210 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1211 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
|
1212 "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
|
1213 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
|
1214 \(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
|
1215 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
|
1216 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
|
1217 (plist, prop) |
7f7e97f219ce
(Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents:
13862
diff
changeset
|
1218 Lisp_Object plist; |
211 | 1219 register Lisp_Object prop; |
1220 { | |
1221 register Lisp_Object tail; | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1222 for (tail = plist; !NILP (tail); tail = Fcdr (XCONS (tail)->cdr)) |
211 | 1223 { |
1224 register Lisp_Object tem; | |
1225 tem = Fcar (tail); | |
1226 if (EQ (prop, tem)) | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1227 return Fcar (XCONS (tail)->cdr); |
211 | 1228 } |
1229 return Qnil; | |
1230 } | |
1231 | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1232 DEFUN ("get", Fget, Sget, 2, 2, 0, |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1233 "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
|
1234 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
|
1235 (symbol, propname) |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1236 Lisp_Object symbol, propname; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1237 { |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1238 CHECK_SYMBOL (symbol, 0); |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1239 return Fplist_get (XSYMBOL (symbol)->plist, propname); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1240 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1241 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1242 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
|
1243 "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
|
1244 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
|
1245 \(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
|
1246 If PROP is already a property on the list, its value is set to VAL,\n\ |
11221 | 1247 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
|
1248 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
|
1249 The PLIST is modified by side effects.") |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1250 (plist, prop, val) |
20004 | 1251 Lisp_Object plist; |
1252 register Lisp_Object prop; | |
1253 Lisp_Object val; | |
211 | 1254 { |
1255 register Lisp_Object tail, prev; | |
1256 Lisp_Object newcell; | |
1257 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
|
1258 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
|
1259 tail = XCONS (XCONS (tail)->cdr)->cdr) |
211 | 1260 { |
11539
d8227796a997
(Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents:
11240
diff
changeset
|
1261 if (EQ (prop, XCONS (tail)->car)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1262 { |
11539
d8227796a997
(Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents:
11240
diff
changeset
|
1263 Fsetcar (XCONS (tail)->cdr, val); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1264 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1265 } |
211 | 1266 prev = tail; |
1267 } | |
1268 newcell = Fcons (prop, Fcons (val, Qnil)); | |
485 | 1269 if (NILP (prev)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1270 return newcell; |
211 | 1271 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
|
1272 Fsetcdr (XCONS (prev)->cdr, newcell); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1273 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1274 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1275 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1276 DEFUN ("put", Fput, Sput, 3, 3, 0, |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1277 "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
|
1278 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
|
1279 (symbol, propname, value) |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1280 Lisp_Object symbol, propname, value; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1281 { |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1282 CHECK_SYMBOL (symbol, 0); |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1283 XSYMBOL (symbol)->plist |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1284 = 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
|
1285 return value; |
211 | 1286 } |
1287 | |
1288 DEFUN ("equal", Fequal, Sequal, 2, 2, 0, | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1289 "Return t if two Lisp objects have similar structure and contents.\n\ |
211 | 1290 They must have the same data type.\n\ |
1291 Conses are compared by comparing the cars and the cdrs.\n\ | |
1292 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
|
1293 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
|
1294 (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
|
1295 Symbols must match exactly.") |
211 | 1296 (o1, o2) |
1297 register Lisp_Object o1, o2; | |
1298 { | |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1299 return internal_equal (o1, o2, 0) ? Qt : Qnil; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1300 } |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1301 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1302 static int |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1303 internal_equal (o1, o2, depth) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1304 register Lisp_Object o1, o2; |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1305 int depth; |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1306 { |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1307 if (depth > 200) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1308 error ("Stack overflow in equal"); |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1309 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1310 tail_recurse: |
211 | 1311 QUIT; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1312 if (EQ (o1, o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1313 return 1; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1314 if (XTYPE (o1) != XTYPE (o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1315 return 0; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1316 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1317 switch (XTYPE (o1)) |
211 | 1318 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1319 #ifdef LISP_FLOAT_TYPE |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1320 case Lisp_Float: |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1321 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
|
1322 #endif |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1323 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1324 case Lisp_Cons: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1325 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
|
1326 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1327 o1 = XCONS (o1)->cdr; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1328 o2 = XCONS (o2)->cdr; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1329 goto tail_recurse; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1330 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1331 case Lisp_Misc: |
11240
2642924d2d21
(internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1332 if (XMISCTYPE (o1) != XMISCTYPE (o2)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1333 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1334 if (OVERLAYP (o1)) |
211 | 1335 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1336 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
|
1337 depth + 1) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1338 || !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
|
1339 depth + 1)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1340 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1341 o1 = XOVERLAY (o1)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1342 o2 = XOVERLAY (o2)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1343 goto tail_recurse; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1344 } |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1345 if (MARKERP (o1)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1346 { |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1347 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
|
1348 && (XMARKER (o1)->buffer == 0 |
20567
d56b7d5c18e8
(internal_equal): For markers, use bytepos instead of bufpos.
Richard M. Stallman <rms@gnu.org>
parents:
20314
diff
changeset
|
1349 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); |
211 | 1350 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1351 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1352 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1353 case Lisp_Vectorlike: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1354 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1355 register int i, size; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1356 size = XVECTOR (o1)->size; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1357 /* 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
|
1358 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
|
1359 same size. */ |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1360 if (XVECTOR (o2)->size != size) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1361 return 0; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1362 /* Boolvectors are compared much like strings. */ |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1363 if (BOOL_VECTOR_P (o1)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1364 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1365 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
1366 = (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
|
1367 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1368 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
|
1369 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1370 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
|
1371 size_in_chars)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1372 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1373 return 1; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1374 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1375 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1376 /* 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
|
1377 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
|
1378 if (size & PSEUDOVECTOR_FLAG) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1379 { |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1380 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1381 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1382 size &= PSEUDOVECTOR_SIZE_MASK; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1383 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1384 for (i = 0; i < size; i++) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1385 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1386 Lisp_Object v1, v2; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1387 v1 = XVECTOR (o1)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1388 v2 = XVECTOR (o2)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1389 if (!internal_equal (v1, v2, depth + 1)) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1390 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1391 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1392 return 1; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1393 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1394 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1395 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1396 case Lisp_String: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1397 if (XSTRING (o1)->size != XSTRING (o2)->size) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1398 return 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1399 if (XSTRING (o1)->size_byte != XSTRING (o2)->size_byte) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1400 return 0; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1401 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1402 XSTRING (o1)->size_byte)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1403 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1404 return 1; |
211 | 1405 } |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1406 return 0; |
211 | 1407 } |
1408 | |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
1409 extern Lisp_Object Fmake_char_internal (); |
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
1410 |
211 | 1411 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
|
1412 "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
|
1413 ARRAY is a vector, string, char-table, or bool-vector.") |
211 | 1414 (array, item) |
1415 Lisp_Object array, item; | |
1416 { | |
1417 register int size, index, charval; | |
1418 retry: | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
1419 if (VECTORP (array)) |
211 | 1420 { |
1421 register Lisp_Object *p = XVECTOR (array)->contents; | |
1422 size = XVECTOR (array)->size; | |
1423 for (index = 0; index < size; index++) | |
1424 p[index] = item; | |
1425 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1426 else if (CHAR_TABLE_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1427 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1428 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
|
1429 size = CHAR_TABLE_ORDINARY_SLOTS; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1430 for (index = 0; index < size; index++) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1431 p[index] = item; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1432 XCHAR_TABLE (array)->defalt = Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1433 } |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
1434 else if (STRINGP (array)) |
211 | 1435 { |
1436 register unsigned char *p = XSTRING (array)->data; | |
1437 CHECK_NUMBER (item, 1); | |
1438 charval = XINT (item); | |
1439 size = XSTRING (array)->size; | |
1440 for (index = 0; index < size; index++) | |
1441 p[index] = charval; | |
1442 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1443 else if (BOOL_VECTOR_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1444 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1445 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
|
1446 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
1447 = (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
|
1448 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1449 charval = (! NILP (item) ? -1 : 0); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1450 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
|
1451 p[index] = charval; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1452 } |
211 | 1453 else |
1454 { | |
1455 array = wrong_type_argument (Qarrayp, array); | |
1456 goto retry; | |
1457 } | |
1458 return array; | |
1459 } | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1460 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1461 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
|
1462 1, 1, 0, |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1463 "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
|
1464 (char_table) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1465 Lisp_Object char_table; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1466 { |
20004 | 1467 CHECK_CHAR_TABLE (char_table, 0); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1468 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1469 return XCHAR_TABLE (char_table)->purpose; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1470 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1471 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1472 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
|
1473 1, 1, 0, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1474 "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
|
1475 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
|
1476 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
|
1477 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
|
1478 \(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
|
1479 (char_table) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1480 Lisp_Object char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1481 { |
20004 | 1482 CHECK_CHAR_TABLE (char_table, 0); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1483 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1484 return XCHAR_TABLE (char_table)->parent; |
13140
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 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1487 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
|
1488 2, 2, 0, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1489 "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
|
1490 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
|
1491 (char_table, parent) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1492 Lisp_Object char_table, parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1493 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1494 Lisp_Object temp; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1495 |
20004 | 1496 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
|
1497 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1498 if (!NILP (parent)) |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1499 { |
20004 | 1500 CHECK_CHAR_TABLE (parent, 0); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1501 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1502 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
|
1503 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
|
1504 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
|
1505 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1506 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1507 XCHAR_TABLE (char_table)->parent = parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1508 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1509 return parent; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1510 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1511 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1512 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
|
1513 2, 2, 0, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
1514 "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
|
1515 (char_table, n) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1516 Lisp_Object char_table, n; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1517 { |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1518 CHECK_CHAR_TABLE (char_table, 1); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1519 CHECK_NUMBER (n, 2); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1520 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
|
1521 || 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
|
1522 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
|
1523 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1524 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
|
1525 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1526 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1527 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
|
1528 Sset_char_table_extra_slot, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1529 3, 3, 0, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
1530 "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
|
1531 (char_table, n, value) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1532 Lisp_Object char_table, n, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1533 { |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1534 CHECK_CHAR_TABLE (char_table, 1); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1535 CHECK_NUMBER (n, 2); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1536 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
|
1537 || 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
|
1538 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
|
1539 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1540 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
|
1541 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1542 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1543 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
|
1544 2, 2, 0, |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1545 "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
|
1546 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
|
1547 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
|
1548 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
|
1549 (char_table, range) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1550 Lisp_Object char_table, range; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1551 { |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1552 int i; |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1553 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1554 CHECK_CHAR_TABLE (char_table, 0); |
20004 | 1555 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1556 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
|
1557 return XCHAR_TABLE (char_table)->defalt; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1558 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
|
1559 return Faref (char_table, range); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1560 else if (VECTORP (range)) |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1561 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1562 if (XVECTOR (range)->size == 1) |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1563 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
|
1564 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1565 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1566 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1567 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1568 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
|
1569 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1570 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1571 return Faref (char_table, ch); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1572 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1573 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1574 else |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1575 error ("Invalid RANGE argument to `char-table-range'"); |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1576 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1577 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1578 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
|
1579 3, 3, 0, |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1580 "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
|
1581 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
|
1582 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
|
1583 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
|
1584 (char_table, range, value) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1585 Lisp_Object char_table, range, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1586 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1587 int i; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1588 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1589 CHECK_CHAR_TABLE (char_table, 0); |
20004 | 1590 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1591 if (EQ (range, Qt)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1592 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
|
1593 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
|
1594 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
|
1595 XCHAR_TABLE (char_table)->defalt = value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1596 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
|
1597 Faset (char_table, range, value); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1598 else if (VECTORP (range)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1599 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1600 if (XVECTOR (range)->size == 1) |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1601 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
|
1602 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1603 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1604 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1605 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1606 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
|
1607 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1608 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1609 return Faset (char_table, ch, value); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
1610 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1611 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1612 else |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1613 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
|
1614 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1615 return value; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1616 } |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1617 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1618 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
|
1619 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
|
1620 "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
|
1621 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
|
1622 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
|
1623 (char_table, ch, value) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1624 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
|
1625 { |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1626 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
|
1627 Lisp_Object temp; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1628 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1629 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
|
1630 CHECK_NUMBER (ch, 1); |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1631 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1632 c = XINT (ch); |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1633 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
|
1634 if (! CHARSET_DEFINED_P (charset)) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1635 error ("Invalid character: %d", c); |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1636 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1637 if (charset == CHARSET_ASCII) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1638 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
|
1639 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1640 /* 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
|
1641 generic char is specified. */ |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1642 if (CHARSET_DIMENSION (charset) == 1) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1643 code1 = 0; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1644 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
|
1645 if (!code1) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1646 { |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1647 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
|
1648 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1649 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1650 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
|
1651 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1652 } |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1653 char_table = temp; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1654 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
|
1655 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
|
1656 = make_sub_char_table (temp)); |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1657 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
|
1658 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
|
1659 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1660 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1661 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
|
1662 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
1663 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1664 |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1665 /* 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
|
1666 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
|
1667 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
|
1668 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
|
1669 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
|
1670 |
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1671 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
|
1672 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1673 void |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1674 map_char_table (c_function, function, subtable, arg, depth, indices) |
20314
3fb425cf6a83
* fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents:
20148
diff
changeset
|
1675 void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); |
3fb425cf6a83
* fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents:
20148
diff
changeset
|
1676 Lisp_Object function, subtable, arg, *indices; |
16105
1712db4a1709
(map_char_table): Declare depth as int.
Richard M. Stallman <rms@gnu.org>
parents:
15966
diff
changeset
|
1677 int depth; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1678 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1679 int i, to; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1680 |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
1681 if (depth == 0) |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1682 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1683 /* 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
|
1684 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
|
1685 { |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1686 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
|
1687 if (c_function) |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1688 (*c_function) (arg, make_number (i), elt); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1689 else |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1690 call2 (function, make_number (i), elt); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1691 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1692 #if 0 /* If the char table has entries for higher characters, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1693 we should report them. */ |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
1694 if (NILP (current_buffer->enable_multibyte_characters)) |
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
1695 return; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1696 #endif |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1697 to = CHAR_TABLE_ORDINARY_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1698 } |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
1699 else |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1700 { |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
1701 i = 32; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1702 to = SUB_CHAR_TABLE_ORDINARY_SLOTS; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1703 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1704 |
18000
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
1705 for (; i < to; i++) |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1706 { |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1707 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
|
1708 |
18108
af791b0f0657
(map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents:
18035
diff
changeset
|
1709 XSETFASTINT (indices[depth], i); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1710 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1711 if (SUB_CHAR_TABLE_P (elt)) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1712 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1713 if (depth >= 3) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1714 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
|
1715 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
|
1716 } |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1717 else |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
1718 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1719 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
|
1720 |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
1721 if (CHARSET_DEFINED_P (charset)) |
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
1722 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1723 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1724 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
1725 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
|
1726 if (c_function) |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1727 (*c_function) (arg, make_number (c), elt); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1728 else |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1729 call2 (function, make_number (c), elt); |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
1730 } |
20004 | 1731 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1732 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1733 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1734 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1735 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
|
1736 2, 2, 0, |
18000
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
1737 "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
|
1738 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
|
1739 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
|
1740 (function, char_table) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1741 Lisp_Object function, char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1742 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
1743 /* 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
|
1744 Lisp_Object indices[3]; |
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
1745 |
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
1746 CHECK_CHAR_TABLE (char_table, 1); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1747 |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
1748 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
|
1749 return Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1750 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1751 |
211 | 1752 /* ARGSUSED */ |
1753 Lisp_Object | |
1754 nconc2 (s1, s2) | |
1755 Lisp_Object s1, s2; | |
1756 { | |
1757 #ifdef NO_ARG_ARRAY | |
1758 Lisp_Object args[2]; | |
1759 args[0] = s1; | |
1760 args[1] = s2; | |
1761 return Fnconc (2, args); | |
1762 #else | |
1763 return Fnconc (2, &s1); | |
1764 #endif /* NO_ARG_ARRAY */ | |
1765 } | |
1766 | |
1767 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0, | |
1768 "Concatenate any number of lists by altering them.\n\ | |
1769 Only the last argument is not altered, and need not be a list.") | |
1770 (nargs, args) | |
1771 int nargs; | |
1772 Lisp_Object *args; | |
1773 { | |
1774 register int argnum; | |
1775 register Lisp_Object tail, tem, val; | |
1776 | |
1777 val = Qnil; | |
1778 | |
1779 for (argnum = 0; argnum < nargs; argnum++) | |
1780 { | |
1781 tem = args[argnum]; | |
485 | 1782 if (NILP (tem)) continue; |
211 | 1783 |
485 | 1784 if (NILP (val)) |
211 | 1785 val = tem; |
1786 | |
1787 if (argnum + 1 == nargs) break; | |
1788 | |
1789 if (!CONSP (tem)) | |
1790 tem = wrong_type_argument (Qlistp, tem); | |
1791 | |
1792 while (CONSP (tem)) | |
1793 { | |
1794 tail = tem; | |
1795 tem = Fcdr (tail); | |
1796 QUIT; | |
1797 } | |
1798 | |
1799 tem = args[argnum + 1]; | |
1800 Fsetcdr (tail, tem); | |
485 | 1801 if (NILP (tem)) |
211 | 1802 args[argnum + 1] = tail; |
1803 } | |
1804 | |
1805 return val; | |
1806 } | |
1807 | |
1808 /* This is the guts of all mapping functions. | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1809 Apply FN to each element of SEQ, one by one, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1810 storing the results into elements of VALS, a C vector of Lisp_Objects. |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1811 LENI is the length of VALS, which should also be the length of SEQ. */ |
211 | 1812 |
1813 static void | |
1814 mapcar1 (leni, vals, fn, seq) | |
1815 int leni; | |
1816 Lisp_Object *vals; | |
1817 Lisp_Object fn, seq; | |
1818 { | |
1819 register Lisp_Object tail; | |
1820 Lisp_Object dummy; | |
1821 register int i; | |
1822 struct gcpro gcpro1, gcpro2, gcpro3; | |
1823 | |
1824 /* Don't let vals contain any garbage when GC happens. */ | |
1825 for (i = 0; i < leni; i++) | |
1826 vals[i] = Qnil; | |
1827 | |
1828 GCPRO3 (dummy, fn, seq); | |
1829 gcpro1.var = vals; | |
1830 gcpro1.nvars = leni; | |
1831 /* We need not explicitly protect `tail' because it is used only on lists, and | |
1832 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ | |
1833 | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
1834 if (VECTORP (seq)) |
211 | 1835 { |
1836 for (i = 0; i < leni; i++) | |
1837 { | |
1838 dummy = XVECTOR (seq)->contents[i]; | |
1839 vals[i] = call1 (fn, dummy); | |
1840 } | |
1841 } | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1842 else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq)) |
211 | 1843 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1844 /* Single-byte string. */ |
211 | 1845 for (i = 0; i < leni; i++) |
1846 { | |
9308
2c594629baaa
(Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9289
diff
changeset
|
1847 XSETFASTINT (dummy, XSTRING (seq)->data[i]); |
211 | 1848 vals[i] = call1 (fn, dummy); |
1849 } | |
1850 } | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1851 else if (STRINGP (seq)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1852 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1853 /* Multi-byte string. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1854 int len_byte = XSTRING (seq)->size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1855 int i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1856 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1857 for (i = 0, i_byte = 0; i < leni;) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1858 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1859 int c; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1860 FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1861 XSETFASTINT (dummy, c); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1862 vals[i] = call1 (fn, dummy); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1863 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1864 } |
211 | 1865 else /* Must be a list, since Flength did not get an error */ |
1866 { | |
1867 tail = seq; | |
1868 for (i = 0; i < leni; i++) | |
1869 { | |
1870 vals[i] = call1 (fn, Fcar (tail)); | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1871 tail = XCONS (tail)->cdr; |
211 | 1872 } |
1873 } | |
1874 | |
1875 UNGCPRO; | |
1876 } | |
1877 | |
1878 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
|
1879 "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
|
1880 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
|
1881 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
|
1882 (function, sequence, separator) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1883 Lisp_Object function, sequence, separator; |
211 | 1884 { |
1885 Lisp_Object len; | |
1886 register int leni; | |
1887 int nargs; | |
1888 register Lisp_Object *args; | |
1889 register int i; | |
1890 struct gcpro gcpro1; | |
1891 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1892 len = Flength (sequence); |
211 | 1893 leni = XINT (len); |
1894 nargs = leni + leni - 1; | |
1895 if (nargs < 0) return build_string (""); | |
1896 | |
1897 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); | |
1898 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1899 GCPRO1 (separator); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1900 mapcar1 (leni, args, function, sequence); |
211 | 1901 UNGCPRO; |
1902 | |
1903 for (i = leni - 1; i >= 0; i--) | |
1904 args[i + i] = args[i]; | |
20004 | 1905 |
211 | 1906 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
|
1907 args[i] = separator; |
211 | 1908 |
1909 return Fconcat (nargs, args); | |
1910 } | |
1911 | |
1912 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0, | |
1913 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\ | |
1914 The result is a list just as long as SEQUENCE.\n\ | |
1915 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
|
1916 (function, sequence) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1917 Lisp_Object function, sequence; |
211 | 1918 { |
1919 register Lisp_Object len; | |
1920 register int leni; | |
1921 register Lisp_Object *args; | |
1922 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1923 len = Flength (sequence); |
211 | 1924 leni = XFASTINT (len); |
1925 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object)); | |
1926 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1927 mapcar1 (leni, args, function, sequence); |
211 | 1928 |
1929 return Flist (leni, args); | |
1930 } | |
1931 | |
1932 /* Anything that calls this function must protect from GC! */ | |
1933 | |
1934 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, | |
1935 "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
|
1936 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
|
1937 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\ |
211 | 1938 No confirmation of the answer is requested; a single character is enough.\n\ |
1939 Also accepts Space to mean yes, or Delete to mean no.") | |
1940 (prompt) | |
1941 Lisp_Object prompt; | |
1942 { | |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
1943 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
|
1944 register int answer; |
211 | 1945 Lisp_Object xprompt; |
1946 Lisp_Object args[2]; | |
1947 struct gcpro gcpro1, gcpro2; | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
1948 int count = specpdl_ptr - specpdl; |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
1949 |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
1950 specbind (Qcursor_in_echo_area, Qt); |
211 | 1951 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
1952 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
|
1953 |
211 | 1954 CHECK_STRING (prompt, 0); |
1955 xprompt = prompt; | |
1956 GCPRO2 (prompt, xprompt); | |
1957 | |
1958 while (1) | |
1959 { | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
1960 |
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
|
1961 #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
|
1962 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
1963 && use_dialog_box |
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
|
1964 && 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
|
1965 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
1966 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
|
1967 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
|
1968 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
|
1969 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
|
1970 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
|
1971 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
|
1972 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
|
1973 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
|
1974 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
|
1975 } |
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
|
1976 #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
|
1977 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
|
1978 choose_minibuf_frame (); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1979 message_with_string ("%s(y or n) ", xprompt, 0); |
211 | 1980 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1981 if (minibuffer_auto_raise) |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1982 { |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1983 Lisp_Object mini_frame; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1984 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1985 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1986 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1987 Fraise_frame (mini_frame); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1988 } |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
1989 |
6850
d2d8b40fb599
(Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents:
6478
diff
changeset
|
1990 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
|
1991 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
|
1992 /* 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
|
1993 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
|
1994 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
1995 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
|
1996 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
|
1997 answer_string = Fsingle_key_description (obj); |
211 | 1998 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
1999 if (EQ (def, intern ("skip"))) |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2000 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2001 answer = 0; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2002 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2003 } |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2004 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
|
2005 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2006 answer = 1; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2007 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2008 } |
2311
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2009 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
|
2010 { |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2011 Frecenter (Qnil); |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2012 xprompt = prompt; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2013 continue; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2014 } |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2015 else if (EQ (def, intern ("quit"))) |
211 | 2016 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
|
2017 /* 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
|
2018 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
|
2019 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
|
2020 Vquit_flag = Qt; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2021 |
211 | 2022 QUIT; |
1194 | 2023 |
2024 /* If we don't clear this, then the next call to read_char will | |
2025 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
|
2026 Vquit_flag = Qnil; |
211 | 2027 |
2028 Fding (Qnil); | |
2029 Fdiscard_input (); | |
2030 if (EQ (xprompt, prompt)) | |
2031 { | |
2032 args[0] = build_string ("Please answer y or n. "); | |
2033 args[1] = prompt; | |
2034 xprompt = Fconcat (2, args); | |
2035 } | |
2036 } | |
2037 UNGCPRO; | |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2038 |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2039 if (! noninteractive) |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2040 { |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2041 cursor_in_echo_area = -1; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2042 message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n", |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2043 xprompt, 0); |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2044 } |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2045 |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2046 unbind_to (count, Qnil); |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2047 return answer ? Qt : Qnil; |
211 | 2048 } |
2049 | |
2050 /* This is how C code calls `yes-or-no-p' and allows the user | |
2051 to redefined it. | |
2052 | |
2053 Anything that calls this function must protect from GC! */ | |
2054 | |
2055 Lisp_Object | |
2056 do_yes_or_no_p (prompt) | |
2057 Lisp_Object prompt; | |
2058 { | |
2059 return call1 (intern ("yes-or-no-p"), prompt); | |
2060 } | |
2061 | |
2062 /* Anything that calls this function must protect from GC! */ | |
2063 | |
2064 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
|
2065 "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
|
2066 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
|
2067 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
|
2068 The user must confirm the answer with RET,\n\ |
11194 | 2069 and can edit it until it has been confirmed.") |
211 | 2070 (prompt) |
2071 Lisp_Object prompt; | |
2072 { | |
2073 register Lisp_Object ans; | |
2074 Lisp_Object args[2]; | |
2075 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
|
2076 Lisp_Object menu; |
211 | 2077 |
2078 CHECK_STRING (prompt, 0); | |
2079 | |
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
|
2080 #ifdef HAVE_MENUS |
20004 | 2081 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
2082 && use_dialog_box |
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
|
2083 && 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
|
2084 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2085 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
|
2086 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
|
2087 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
|
2088 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
|
2089 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
|
2090 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
|
2091 menu = Fcons (prompt, pane); |
6344 | 2092 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
|
2093 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
|
2094 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
|
2095 } |
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
|
2096 #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
|
2097 |
211 | 2098 args[0] = prompt; |
2099 args[1] = build_string ("(yes or no) "); | |
2100 prompt = Fconcat (2, args); | |
2101 | |
2102 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
|
2103 |
211 | 2104 while (1) |
2105 { | |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
2106 ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil, |
19542
6d3cc8864678
(Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents:
19383
diff
changeset
|
2107 Qyes_or_no_p_history, Qnil, |
6d3cc8864678
(Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents:
19383
diff
changeset
|
2108 Qnil)); |
211 | 2109 if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes")) |
2110 { | |
2111 UNGCPRO; | |
2112 return Qt; | |
2113 } | |
2114 if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no")) | |
2115 { | |
2116 UNGCPRO; | |
2117 return Qnil; | |
2118 } | |
2119 | |
2120 Fding (Qnil); | |
2121 Fdiscard_input (); | |
2122 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
|
2123 Fsleep_for (make_number (2), Qnil); |
211 | 2124 } |
2125 } | |
2126 | |
2127 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0, | |
2128 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\ | |
2129 Each of the three load averages is multiplied by 100,\n\ | |
727 | 2130 then converted to integer.\n\ |
2131 If the 5-minute or 15-minute load averages are not available, return a\n\ | |
2132 shortened list, containing only those averages which are available.") | |
211 | 2133 () |
2134 { | |
727 | 2135 double load_ave[3]; |
2136 int loads = getloadavg (load_ave, 3); | |
2137 Lisp_Object ret; | |
211 | 2138 |
727 | 2139 if (loads < 0) |
2140 error ("load-average not implemented for this operating system"); | |
211 | 2141 |
727 | 2142 ret = Qnil; |
2143 while (loads > 0) | |
2144 ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret); | |
211 | 2145 |
727 | 2146 return ret; |
211 | 2147 } |
2148 | |
2149 Lisp_Object Vfeatures; | |
2150 | |
2151 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0, | |
2152 "Returns t if FEATURE is present in this Emacs.\n\ | |
2153 Use this to conditionalize execution of lisp code based on the presence or\n\ | |
2154 absence of emacs or environment extensions.\n\ | |
2155 Use `provide' to declare that a feature is available.\n\ | |
2156 This function looks at the value of the variable `features'.") | |
20004 | 2157 (feature) |
211 | 2158 Lisp_Object feature; |
2159 { | |
2160 register Lisp_Object tem; | |
2161 CHECK_SYMBOL (feature, 0); | |
2162 tem = Fmemq (feature, Vfeatures); | |
485 | 2163 return (NILP (tem)) ? Qnil : Qt; |
211 | 2164 } |
2165 | |
2166 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0, | |
2167 "Announce that FEATURE is a feature of the current Emacs.") | |
20004 | 2168 (feature) |
211 | 2169 Lisp_Object feature; |
2170 { | |
2171 register Lisp_Object tem; | |
2172 CHECK_SYMBOL (feature, 0); | |
485 | 2173 if (!NILP (Vautoload_queue)) |
211 | 2174 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); |
2175 tem = Fmemq (feature, Vfeatures); | |
485 | 2176 if (NILP (tem)) |
211 | 2177 Vfeatures = Fcons (feature, Vfeatures); |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2178 LOADHIST_ATTACH (Fcons (Qprovide, feature)); |
211 | 2179 return feature; |
2180 } | |
2181 | |
2182 DEFUN ("require", Frequire, Srequire, 1, 2, 0, | |
2183 "If feature FEATURE is not loaded, load it from FILENAME.\n\ | |
2184 If FEATURE is not a member of the list `features', then the feature\n\ | |
2185 is not loaded; so load the file FILENAME.\n\ | |
2186 If FILENAME is omitted, the printname of FEATURE is used as the file name.") | |
20004 | 2187 (feature, file_name) |
211 | 2188 Lisp_Object feature, file_name; |
2189 { | |
2190 register Lisp_Object tem; | |
2191 CHECK_SYMBOL (feature, 0); | |
2192 tem = Fmemq (feature, Vfeatures); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2193 LOADHIST_ATTACH (Fcons (Qrequire, feature)); |
485 | 2194 if (NILP (tem)) |
211 | 2195 { |
2196 int count = specpdl_ptr - specpdl; | |
2197 | |
2198 /* Value saved here is to be restored into Vautoload_queue */ | |
2199 record_unwind_protect (un_autoload, Vautoload_queue); | |
2200 Vautoload_queue = Qt; | |
2201 | |
485 | 2202 Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name, |
19223
475cf041a683
(Frequire): Don't insist on a suffix
Richard M. Stallman <rms@gnu.org>
parents:
19117
diff
changeset
|
2203 Qnil, Qt, Qnil, (NILP (file_name) ? Qt : Qnil)); |
211 | 2204 |
2205 tem = Fmemq (feature, Vfeatures); | |
485 | 2206 if (NILP (tem)) |
211 | 2207 error ("Required feature %s was not provided", |
19223
475cf041a683
(Frequire): Don't insist on a suffix
Richard M. Stallman <rms@gnu.org>
parents:
19117
diff
changeset
|
2208 XSYMBOL (feature)->name->data); |
211 | 2209 |
2210 /* Once loading finishes, don't undo it. */ | |
2211 Vautoload_queue = Qt; | |
2212 feature = unbind_to (count, feature); | |
2213 } | |
2214 return feature; | |
2215 } | |
2216 | |
20004 | 2217 /* Primitives for work of the "widget" library. |
2218 In an ideal world, this section would not have been necessary. | |
2219 However, lisp function calls being as slow as they are, it turns | |
2220 out that some functions in the widget library (wid-edit.el) are the | |
2221 bottleneck of Widget operation. Here is their translation to C, | |
2222 for the sole reason of efficiency. */ | |
2223 | |
2224 DEFUN ("widget-plist-member", Fwidget_plist_member, Swidget_plist_member, 2, 2, 0, | |
2225 "Return non-nil if PLIST has the property PROP.\n\ | |
2226 PLIST is a property list, which is a list of the form\n\ | |
2227 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\ | |
2228 Unlike `plist-get', this allows you to distinguish between a missing\n\ | |
2229 property and a property with the value nil.\n\ | |
2230 The value is actually the tail of PLIST whose car is PROP.") | |
2231 (plist, prop) | |
2232 Lisp_Object plist, prop; | |
2233 { | |
2234 while (CONSP (plist) && !EQ (XCAR (plist), prop)) | |
2235 { | |
2236 QUIT; | |
2237 plist = XCDR (plist); | |
2238 plist = CDR (plist); | |
2239 } | |
2240 return plist; | |
2241 } | |
2242 | |
2243 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, | |
2244 "In WIDGET, set PROPERTY to VALUE.\n\ | |
2245 The value can later be retrieved with `widget-get'.") | |
2246 (widget, property, value) | |
2247 Lisp_Object widget, property, value; | |
2248 { | |
2249 CHECK_CONS (widget, 1); | |
2250 XCDR (widget) = Fplist_put (XCDR (widget), property, value); | |
2251 } | |
2252 | |
2253 DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0, | |
2254 "In WIDGET, get the value of PROPERTY.\n\ | |
2255 The value could either be specified when the widget was created, or\n\ | |
2256 later with `widget-put'.") | |
2257 (widget, property) | |
2258 Lisp_Object widget, property; | |
2259 { | |
2260 Lisp_Object tmp; | |
2261 | |
2262 while (1) | |
2263 { | |
2264 if (NILP (widget)) | |
2265 return Qnil; | |
2266 CHECK_CONS (widget, 1); | |
2267 tmp = Fwidget_plist_member (XCDR (widget), property); | |
2268 if (CONSP (tmp)) | |
2269 { | |
2270 tmp = XCDR (tmp); | |
2271 return CAR (tmp); | |
2272 } | |
2273 tmp = XCAR (widget); | |
2274 if (NILP (tmp)) | |
2275 return Qnil; | |
2276 widget = Fget (tmp, Qwidget_type); | |
2277 } | |
2278 } | |
2279 | |
2280 DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0, | |
2281 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\ | |
2282 ARGS are passed as extra arguments to the function.") | |
2283 (nargs, args) | |
2284 int nargs; | |
2285 Lisp_Object *args; | |
2286 { | |
2287 /* This function can GC. */ | |
2288 Lisp_Object newargs[3]; | |
2289 struct gcpro gcpro1, gcpro2; | |
2290 Lisp_Object result; | |
2291 | |
2292 newargs[0] = Fwidget_get (args[0], args[1]); | |
2293 newargs[1] = args[0]; | |
2294 newargs[2] = Flist (nargs - 2, args + 2); | |
2295 GCPRO2 (newargs[0], newargs[2]); | |
2296 result = Fapply (3, newargs); | |
2297 UNGCPRO; | |
2298 return result; | |
2299 } | |
2300 | |
211 | 2301 syms_of_fns () |
2302 { | |
2303 Qstring_lessp = intern ("string-lessp"); | |
2304 staticpro (&Qstring_lessp); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2305 Qprovide = intern ("provide"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2306 staticpro (&Qprovide); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2307 Qrequire = intern ("require"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2308 staticpro (&Qrequire); |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
2309 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
|
2310 staticpro (&Qyes_or_no_p_history); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2311 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
|
2312 staticpro (&Qcursor_in_echo_area); |
20004 | 2313 Qwidget_type = intern ("widget-type"); |
2314 staticpro (&Qwidget_type); | |
211 | 2315 |
14486
3c4ba112108e
(syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents:
14456
diff
changeset
|
2316 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
|
2317 |
211 | 2318 DEFVAR_LISP ("features", &Vfeatures, |
2319 "A list of symbols which are the features of the executing emacs.\n\ | |
2320 Used by `featurep' and `require', and altered by `provide'."); | |
2321 Vfeatures = Qnil; | |
2322 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
2323 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box, |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
2324 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\ |
18686
186f1b58028d
(syms_of_fns): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
2325 This applies to y-or-n and yes-or-no questions asked by commands\n\ |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
2326 invoked by mouse clicks and mouse menu items."); |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
2327 use_dialog_box = 1; |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
2328 |
211 | 2329 defsubr (&Sidentity); |
2330 defsubr (&Srandom); | |
2331 defsubr (&Slength); | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
2332 defsubr (&Ssafe_length); |
211 | 2333 defsubr (&Sstring_equal); |
2334 defsubr (&Sstring_lessp); | |
2335 defsubr (&Sappend); | |
2336 defsubr (&Sconcat); | |
2337 defsubr (&Svconcat); | |
2338 defsubr (&Scopy_sequence); | |
2339 defsubr (&Scopy_alist); | |
2340 defsubr (&Ssubstring); | |
2341 defsubr (&Snthcdr); | |
2342 defsubr (&Snth); | |
2343 defsubr (&Selt); | |
2344 defsubr (&Smember); | |
2345 defsubr (&Smemq); | |
2346 defsubr (&Sassq); | |
2347 defsubr (&Sassoc); | |
2348 defsubr (&Srassq); | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
2349 defsubr (&Srassoc); |
211 | 2350 defsubr (&Sdelq); |
414 | 2351 defsubr (&Sdelete); |
211 | 2352 defsubr (&Snreverse); |
2353 defsubr (&Sreverse); | |
2354 defsubr (&Ssort); | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2355 defsubr (&Splist_get); |
211 | 2356 defsubr (&Sget); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2357 defsubr (&Splist_put); |
211 | 2358 defsubr (&Sput); |
2359 defsubr (&Sequal); | |
2360 defsubr (&Sfillarray); | |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2361 defsubr (&Schar_table_subtype); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2362 defsubr (&Schar_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2363 defsubr (&Sset_char_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2364 defsubr (&Schar_table_extra_slot); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2365 defsubr (&Sset_char_table_extra_slot); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2366 defsubr (&Schar_table_range); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2367 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
|
2368 defsubr (&Sset_char_table_default); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2369 defsubr (&Smap_char_table); |
211 | 2370 defsubr (&Snconc); |
2371 defsubr (&Smapcar); | |
2372 defsubr (&Smapconcat); | |
2373 defsubr (&Sy_or_n_p); | |
2374 defsubr (&Syes_or_no_p); | |
2375 defsubr (&Sload_average); | |
2376 defsubr (&Sfeaturep); | |
2377 defsubr (&Srequire); | |
2378 defsubr (&Sprovide); | |
20004 | 2379 defsubr (&Swidget_plist_member); |
2380 defsubr (&Swidget_put); | |
2381 defsubr (&Swidget_get); | |
2382 defsubr (&Swidget_apply); | |
211 | 2383 } |