Mercurial > emacs
annotate src/fns.c @ 25177:0ac130f2181a
(outline-previous-heading): New function.
(outline-up-heading-all): Use outline-previous-heading.
(outline-next-heading): Delete definition inserted yesterday.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 05 Aug 1999 14:50:30 +0000 |
parents | ee483f870bde |
children | ee30c32ea191 |
rev | line source |
---|---|
211 | 1 /* Random utility Lisp functions. |
24280
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 1999 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 |
21514 | 24 #ifdef HAVE_UNISTD_H |
25 #include <unistd.h> | |
26 #endif | |
21841
12c75f0ef578
Include <time.h> for time.
Andreas Schwab <schwab@suse.de>
parents:
21810
diff
changeset
|
27 #include <time.h> |
21514 | 28 |
211 | 29 /* Note on some machines this defines `vector' as a typedef, |
30 so make sure we don't use that name in this file. */ | |
31 #undef vector | |
32 #define vector ***** | |
33 | |
34 #include "lisp.h" | |
35 #include "commands.h" | |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
36 #include "charset.h" |
211 | 37 |
38 #include "buffer.h" | |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
39 #include "keyboard.h" |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
40 #include "intervals.h" |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
41 #include "frame.h" |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
42 #include "window.h" |
21810
15f5abff4d9b
[HAVE_MENUS]: Include xterm.h only if HAVE_X_WINDOWS.
Richard M. Stallman <rms@gnu.org>
parents:
21791
diff
changeset
|
43 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS) |
21514 | 44 #include "xterm.h" |
45 #endif | |
211 | 46 |
12062 | 47 #ifndef NULL |
48 #define NULL (void *)0 | |
49 #endif | |
50 | |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
51 #ifndef min |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
52 #define min(a, b) ((a) < (b) ? (a) : (b)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
53 #define max(a, b) ((a) > (b) ? (a) : (b)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
54 #endif |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
55 |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
56 /* 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
|
57 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
|
58 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
|
59 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
60 extern int minibuffer_auto_raise; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
61 extern Lisp_Object minibuf_window; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
62 |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
63 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
|
64 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
|
65 Lisp_Object Qcursor_in_echo_area; |
20004 | 66 Lisp_Object Qwidget_type; |
211 | 67 |
23051
18ed8d6b11e5
(Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents:
22853
diff
changeset
|
68 extern Lisp_Object Qinput_method_function; |
18ed8d6b11e5
(Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents:
22853
diff
changeset
|
69 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
70 static int internal_equal (); |
21580
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
71 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
72 extern long get_random (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
73 extern void seed_random (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
74 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
75 #ifndef HAVE_UNISTD_H |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
76 extern long time (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
77 #endif |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
78 |
211 | 79 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
80 "Return the argument unchanged.") | |
81 (arg) | |
82 Lisp_Object arg; | |
83 { | |
84 return arg; | |
85 } | |
86 | |
87 DEFUN ("random", Frandom, Srandom, 0, 1, 0, | |
88 "Return a pseudo-random number.\n\ | |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
89 All integers representable in Lisp are equally likely.\n\ |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
90 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
|
91 With positive integer argument N, return random number in interval [0,N).\n\ |
211 | 92 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
|
93 (n) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
94 Lisp_Object n; |
211 | 95 { |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
96 EMACS_INT val; |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
97 Lisp_Object lispy_val; |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
98 unsigned long denominator; |
211 | 99 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
100 if (EQ (n, Qt)) |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
101 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
|
102 if (NATNUMP (n) && XFASTINT (n) != 0) |
211 | 103 { |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
104 /* 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
|
105 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
|
106 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
|
107 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
|
108 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
|
109 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
|
110 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
|
111 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
112 do |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
113 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
|
114 while (val >= XFASTINT (n)); |
211 | 115 } |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
116 else |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
117 val = get_random (); |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
118 XSETINT (lispy_val, val); |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
119 return lispy_val; |
211 | 120 } |
121 | |
122 /* Random data-structure functions */ | |
123 | |
124 DEFUN ("length", Flength, Slength, 1, 1, 0, | |
125 "Return the length of vector, list or string SEQUENCE.\n\ | |
19383 | 126 A byte-code function object is also allowed.\n\ |
127 If the string contains multibyte characters, this is not the necessarily\n\ | |
21383 | 128 the number of bytes in the string; it is the number of characters.\n\ |
129 To get the number of bytes, use `string-bytes'") | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
130 (sequence) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
131 register Lisp_Object sequence; |
211 | 132 { |
133 register Lisp_Object tail, val; | |
134 register int i; | |
135 | |
136 retry: | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
137 if (STRINGP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
138 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
|
139 else if (VECTORP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
140 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
|
141 else if (CHAR_TABLE_P (sequence)) |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
142 XSETFASTINT (val, (MIN_CHAR_COMPOSITION |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
143 + (CHAR_FIELD2_MASK | CHAR_FIELD3_MASK) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
144 - 1)); |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
145 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
|
146 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
|
147 else if (COMPILEDP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
148 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
|
149 else if (CONSP (sequence)) |
211 | 150 { |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
151 for (i = 0, tail = sequence; !NILP (tail); i++) |
211 | 152 { |
153 QUIT; | |
154 tail = Fcdr (tail); | |
155 } | |
156 | |
9308
2c594629baaa
(Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9289
diff
changeset
|
157 XSETFASTINT (val, i); |
211 | 158 } |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
159 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
|
160 XSETFASTINT (val, 0); |
211 | 161 else |
162 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
163 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 164 goto retry; |
165 } | |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
166 return val; |
211 | 167 } |
168 | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
169 /* This does not check for quits. That is safe |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
170 since it must terminate. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
171 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
172 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
|
173 "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
|
174 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
|
175 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
|
176 which is at least the number of distinct elements.") |
20004 | 177 (list) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
178 Lisp_Object list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
179 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
180 Lisp_Object tail, halftail, length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
181 int len = 0; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
182 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
183 /* halftail is used to detect circular lists. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
184 halftail = list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
185 for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
186 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
187 if (EQ (tail, halftail) && len != 0) |
12618
60c4c0fee545
(Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents:
12466
diff
changeset
|
188 break; |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
189 len++; |
13344
30e17254a280
(Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents:
13277
diff
changeset
|
190 if ((len & 1) == 0) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
191 halftail = XCONS (halftail)->cdr; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
192 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
193 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
194 XSETINT (length, len); |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
195 return length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
196 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
197 |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
198 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
199 "Return the number of bytes in STRING.\n\ |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
200 If STRING is a multibyte string, this is greater than the length of STRING.") |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
201 (string) |
20881
fd35cf0efd94
(Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents:
20880
diff
changeset
|
202 Lisp_Object string; |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
203 { |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
204 CHECK_STRING (string, 1); |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
205 return make_number (STRING_BYTES (XSTRING (string))); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
206 } |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
207 |
211 | 208 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
|
209 "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
|
210 Case is significant, but text properties are ignored.\n\ |
211 | 211 Symbols are also allowed; their print names are used instead.") |
212 (s1, s2) | |
213 register Lisp_Object s1, s2; | |
214 { | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
215 if (SYMBOLP (s1)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
216 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
|
217 if (SYMBOLP (s2)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
218 XSETSTRING (s2, XSYMBOL (s2)->name); |
211 | 219 CHECK_STRING (s1, 0); |
220 CHECK_STRING (s2, 1); | |
221 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
222 if (XSTRING (s1)->size != XSTRING (s2)->size |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
223 || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2)) |
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
224 || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1)))) |
211 | 225 return Qnil; |
226 return Qt; | |
227 } | |
228 | |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
229 DEFUN ("compare-strings", Fcompare_strings, |
21673
8a32bf93da04
(Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents:
21671
diff
changeset
|
230 Scompare_strings, 6, 7, 0, |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
231 "Compare the contents of two strings, converting to multibyte if needed.\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
232 In string STR1, skip the first START1 characters and stop at END1.\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
233 In string STR2, skip the first START2 characters and stop at END2.\n\ |
21789
c7b93fe649d4
(Fcompare_strings): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21716
diff
changeset
|
234 END1 and END2 default to the full lengths of the respective strings.\n\ |
c7b93fe649d4
(Fcompare_strings): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21716
diff
changeset
|
235 \n\ |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
236 Case is significant in this comparison if IGNORE-CASE is nil.\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
237 Unibyte strings are converted to multibyte for comparison.\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
238 \n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
239 The value is t if the strings (or specified portions) match.\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
240 If string STR1 is less, the value is a negative number N;\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
241 - 1 - N is the number of characters that match at the beginning.\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
242 If string STR1 is greater, the value is a positive number N;\n\ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
243 N - 1 is the number of characters that match at the beginning.") |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
244 (str1, start1, end1, str2, start2, end2, ignore_case) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
245 Lisp_Object str1, start1, end1, start2, str2, end2, ignore_case; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
246 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
247 register int end1_char, end2_char; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
248 register int i1, i1_byte, i2, i2_byte; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
249 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
250 CHECK_STRING (str1, 0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
251 CHECK_STRING (str2, 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
252 if (NILP (start1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
253 start1 = make_number (0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
254 if (NILP (start2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
255 start2 = make_number (0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
256 CHECK_NATNUM (start1, 2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
257 CHECK_NATNUM (start2, 3); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
258 if (! NILP (end1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
259 CHECK_NATNUM (end1, 4); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
260 if (! NILP (end2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
261 CHECK_NATNUM (end2, 4); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
262 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
263 i1 = XINT (start1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
264 i2 = XINT (start2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
265 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
266 i1_byte = string_char_to_byte (str1, i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
267 i2_byte = string_char_to_byte (str2, i2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
268 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
269 end1_char = XSTRING (str1)->size; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
270 if (! NILP (end1) && end1_char > XINT (end1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
271 end1_char = XINT (end1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
272 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
273 end2_char = XSTRING (str2)->size; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
274 if (! NILP (end2) && end2_char > XINT (end2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
275 end2_char = XINT (end2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
276 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
277 while (i1 < end1_char && i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
278 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
279 /* When we find a mismatch, we must compare the |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
280 characters, not just the bytes. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
281 int c1, c2; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
282 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
283 if (STRING_MULTIBYTE (str1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
284 FETCH_STRING_CHAR_ADVANCE (c1, str1, i1, i1_byte); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
285 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
286 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
287 c1 = XSTRING (str1)->data[i1++]; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
288 c1 = unibyte_char_to_multibyte (c1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
289 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
290 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
291 if (STRING_MULTIBYTE (str2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
292 FETCH_STRING_CHAR_ADVANCE (c2, str2, i2, i2_byte); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
293 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
294 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
295 c2 = XSTRING (str2)->data[i2++]; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
296 c2 = unibyte_char_to_multibyte (c2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
297 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
298 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
299 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
300 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
301 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
302 if (! NILP (ignore_case)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
303 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
304 Lisp_Object tem; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
305 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
306 tem = Fupcase (make_number (c1)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
307 c1 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
308 tem = Fupcase (make_number (c2)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
309 c2 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
310 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
311 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
312 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
313 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
314 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
315 /* Note that I1 has already been incremented |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
316 past the character that we are comparing; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
317 hence we don't add or subtract 1 here. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
318 if (c1 < c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
319 return make_number (- i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
320 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
321 return make_number (i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
322 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
323 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
324 if (i1 < end1_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
325 return make_number (i1 - XINT (start1) + 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
326 if (i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
327 return make_number (- i1 + XINT (start1) - 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
328 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
329 return Qt; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
330 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
331 |
211 | 332 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
|
333 "Return t if first arg string is less than second in lexicographic order.\n\ |
211 | 334 Case is significant.\n\ |
335 Symbols are also allowed; their print names are used instead.") | |
336 (s1, s2) | |
337 register Lisp_Object s1, s2; | |
338 { | |
339 register int end; | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
340 register int i1, i1_byte, i2, i2_byte; |
211 | 341 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
342 if (SYMBOLP (s1)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
343 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
|
344 if (SYMBOLP (s2)) |
9289
e5a850de0ba8
(Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents:
9128
diff
changeset
|
345 XSETSTRING (s2, XSYMBOL (s2)->name); |
211 | 346 CHECK_STRING (s1, 0); |
347 CHECK_STRING (s2, 1); | |
348 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
349 i1 = i1_byte = i2 = i2_byte = 0; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
350 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
351 end = XSTRING (s1)->size; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
352 if (end > XSTRING (s2)->size) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
353 end = XSTRING (s2)->size; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
354 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
355 while (i1 < end) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
356 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
357 /* When we find a mismatch, we must compare the |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
358 characters, not just the bytes. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
359 int c1, c2; |
211 | 360 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
361 if (STRING_MULTIBYTE (s1)) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
362 FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
363 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
364 c1 = XSTRING (s1)->data[i1++]; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
365 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
366 if (STRING_MULTIBYTE (s2)) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
367 FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
368 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
369 c2 = XSTRING (s2)->data[i2++]; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
370 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
371 if (c1 != c2) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
372 return c1 < c2 ? Qt : Qnil; |
211 | 373 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
374 return i1 < XSTRING (s2)->size ? Qt : Qnil; |
211 | 375 } |
376 | |
377 static Lisp_Object concat (); | |
378 | |
379 /* ARGSUSED */ | |
380 Lisp_Object | |
381 concat2 (s1, s2) | |
382 Lisp_Object s1, s2; | |
383 { | |
384 #ifdef NO_ARG_ARRAY | |
385 Lisp_Object args[2]; | |
386 args[0] = s1; | |
387 args[1] = s2; | |
388 return concat (2, args, Lisp_String, 0); | |
389 #else | |
390 return concat (2, &s1, Lisp_String, 0); | |
391 #endif /* NO_ARG_ARRAY */ | |
392 } | |
393 | |
8966
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
394 /* ARGSUSED */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
395 Lisp_Object |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
396 concat3 (s1, s2, s3) |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
397 Lisp_Object s1, s2, s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
398 { |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
399 #ifdef NO_ARG_ARRAY |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
400 Lisp_Object args[3]; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
401 args[0] = s1; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
402 args[1] = s2; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
403 args[2] = s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
404 return concat (3, args, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
405 #else |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
406 return concat (3, &s1, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
407 #endif /* NO_ARG_ARRAY */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
408 } |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
409 |
211 | 410 DEFUN ("append", Fappend, Sappend, 0, MANY, 0, |
411 "Concatenate all the arguments and make the result a list.\n\ | |
412 The result is a list whose elements are the elements of all the arguments.\n\ | |
413 Each argument may be a list, vector or string.\n\ | |
1037 | 414 The last argument is not copied, just used as the tail of the new list.") |
211 | 415 (nargs, args) |
416 int nargs; | |
417 Lisp_Object *args; | |
418 { | |
419 return concat (nargs, args, Lisp_Cons, 1); | |
420 } | |
421 | |
422 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, | |
423 "Concatenate all the arguments and make the result a string.\n\ | |
424 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
|
425 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
|
426 \n\ |
41b869bbe0e1
(Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
11138
diff
changeset
|
427 Do not use individual integers as arguments!\n\ |
41b869bbe0e1
(Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
11138
diff
changeset
|
428 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
|
429 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
|
430 you should change it right away not to do so.") |
211 | 431 (nargs, args) |
432 int nargs; | |
433 Lisp_Object *args; | |
434 { | |
435 return concat (nargs, args, Lisp_String, 0); | |
436 } | |
437 | |
438 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, | |
439 "Concatenate all the arguments and make the result a vector.\n\ | |
440 The result is a vector whose elements are the elements of all the arguments.\n\ | |
441 Each argument may be a list, vector or string.") | |
442 (nargs, args) | |
443 int nargs; | |
444 Lisp_Object *args; | |
445 { | |
10006
402c87cbc4fa
(Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9965
diff
changeset
|
446 return concat (nargs, args, Lisp_Vectorlike, 0); |
211 | 447 } |
448 | |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
449 /* 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
|
450 nested sub char table are not copied. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
451 static Lisp_Object |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
452 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
|
453 Lisp_Object arg; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
454 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
455 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
|
456 int i; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
457 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
458 /* Copy all the contents. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
459 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
|
460 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
461 /* 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
|
462 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
|
463 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
|
464 XCHAR_TABLE (copy)->contents[i] |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
465 = 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
|
466 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
467 return copy; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
468 } |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
469 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
470 |
211 | 471 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, |
472 "Return a copy of a list, vector or string.\n\ | |
473 The elements of a list or vector are not copied; they are shared\n\ | |
474 with the original.") | |
475 (arg) | |
476 Lisp_Object arg; | |
477 { | |
485 | 478 if (NILP (arg)) return arg; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
479 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
480 if (CHAR_TABLE_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
481 { |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
482 int i; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
483 Lisp_Object copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
484 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
485 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
|
486 /* 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
|
487 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
488 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) |
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
489 * sizeof (Lisp_Object))); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
490 |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
491 /* 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
|
492 for multibyte characters. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
493 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
494 i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
495 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
|
496 XCHAR_TABLE (copy)->contents[i] |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
497 = 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
|
498 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
499 return copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
500 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
501 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
502 if (BOOL_VECTOR_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
503 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
504 Lisp_Object val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
505 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
506 = (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
|
507 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
508 val = Fmake_bool_vector (Flength (arg), Qnil); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
509 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
|
510 size_in_chars); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
511 return val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
512 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
513 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
514 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) |
211 | 515 arg = wrong_type_argument (Qsequencep, arg); |
516 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); | |
517 } | |
518 | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
519 /* In string STR of length LEN, see if bytes before STR[I] combine |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
520 with bytes after STR[I] to form a single character. If so, return |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
521 the number of bytes after STR[I] which combine in this way. |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
522 Otherwize, return 0. */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
523 |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
524 static int |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
525 count_combining (str, len, i) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
526 unsigned char *str; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
527 int len, i; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
528 { |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
529 int j = i - 1; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
530 |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
531 if (i == 0 || i == len || CHAR_HEAD_P (str[i])) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
532 return 0; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
533 while (j >= 0 && !CHAR_HEAD_P (str[j])) j--; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
534 if (j < 0 || ! BASE_LEADING_CODE_P (str[j])) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
535 return 0; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
536 j = i + 1; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
537 while (j < len && ! CHAR_HEAD_P (str[j])) j++; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
538 return j - i; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
539 } |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
540 |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
541 /* This structure holds information of an argument of `concat' that is |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
542 a string and has text properties to be copied. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
543 struct textprop_rec |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
544 { |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
545 int argnum; /* refer to ARGS (arguments of `concat') */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
546 int from; /* refer to ARGS[argnum] (argument string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
547 int to; /* refer to VAL (the target string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
548 }; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
549 |
211 | 550 static Lisp_Object |
551 concat (nargs, args, target_type, last_special) | |
552 int nargs; | |
553 Lisp_Object *args; | |
554 enum Lisp_Type target_type; | |
555 int last_special; | |
556 { | |
557 Lisp_Object val; | |
558 register Lisp_Object tail; | |
559 register Lisp_Object this; | |
560 int toindex; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
561 int toindex_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
562 register int result_len; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
563 register int result_len_byte; |
211 | 564 register int argnum; |
565 Lisp_Object last_tail; | |
566 Lisp_Object prev; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
567 int some_multibyte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
568 /* When we make a multibyte string, we can't copy text properties |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
569 while concatinating each string because the length of resulting |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
570 string can't be decided until we finish the whole concatination. |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
571 So, we record strings that have text properties to be copied |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
572 here, and copy the text properties after the concatination. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
573 struct textprop_rec *textprops; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
574 /* Number of elments in textprops. */ |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
575 int num_textprops = 0; |
211 | 576 |
577 /* In append, the last arg isn't treated like the others */ | |
578 if (last_special && nargs > 0) | |
579 { | |
580 nargs--; | |
581 last_tail = args[nargs]; | |
582 } | |
583 else | |
584 last_tail = Qnil; | |
585 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
586 /* Canonicalize each argument. */ |
211 | 587 for (argnum = 0; argnum < nargs; argnum++) |
588 { | |
589 this = args[argnum]; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
590 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
|
591 || COMPILEDP (this) || BOOL_VECTOR_P (this))) |
211 | 592 { |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
593 if (INTEGERP (this)) |
11142
41b869bbe0e1
(Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
11138
diff
changeset
|
594 args[argnum] = Fnumber_to_string (this); |
211 | 595 else |
596 args[argnum] = wrong_type_argument (Qsequencep, this); | |
597 } | |
598 } | |
599 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
600 /* 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
|
601 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
|
602 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
|
603 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
|
604 result_len_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
605 result_len = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
606 some_multibyte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
607 for (argnum = 0; argnum < nargs; argnum++) |
211 | 608 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
609 int len; |
211 | 610 this = args[argnum]; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
611 len = XFASTINT (Flength (this)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
612 if (target_type == Lisp_String) |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
613 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
614 /* We must count the number of bytes needed in the string |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
615 as well as the number of characters. */ |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
616 int i; |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
617 Lisp_Object ch; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
618 int this_len_byte; |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
619 |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
620 if (VECTORP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
621 for (i = 0; i < len; i++) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
622 { |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
623 ch = XVECTOR (this)->contents[i]; |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
624 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
625 wrong_type_argument (Qintegerp, ch); |
23128
45de23c16505
(concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents:
23057
diff
changeset
|
626 this_len_byte = CHAR_BYTES (XINT (ch)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
627 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
|
628 if (this_len_byte > 1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
629 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
630 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
631 else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
632 wrong_type_argument (Qintegerp, Faref (this, make_number (0))); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
633 else if (CONSP (this)) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
634 for (; CONSP (this); this = XCONS (this)->cdr) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
635 { |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
636 ch = XCONS (this)->car; |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
637 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
638 wrong_type_argument (Qintegerp, ch); |
23128
45de23c16505
(concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents:
23057
diff
changeset
|
639 this_len_byte = CHAR_BYTES (XINT (ch)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
640 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
|
641 if (this_len_byte > 1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
642 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
643 } |
20639
12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents:
20607
diff
changeset
|
644 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
645 { |
20699
907d8633c8cc
(concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents:
20667
diff
changeset
|
646 if (STRING_MULTIBYTE (this)) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
647 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
648 some_multibyte = 1; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
649 result_len_byte += STRING_BYTES (XSTRING (this)); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
650 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
651 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
652 result_len_byte += count_size_as_multibyte (XSTRING (this)->data, |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
653 XSTRING (this)->size); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
654 } |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
655 } |
20607
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 result_len += len; |
211 | 658 } |
659 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
660 if (! some_multibyte) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
661 result_len_byte = result_len; |
211 | 662 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
663 /* Create the output object. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
664 if (target_type == Lisp_Cons) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
665 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
|
666 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
|
667 val = Fmake_vector (make_number (result_len), Qnil); |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
668 else if (some_multibyte) |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
669 val = make_uninit_multibyte_string (result_len, result_len_byte); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
670 else |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
671 val = make_uninit_string (result_len); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
672 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
673 /* In `append', if all but last arg are nil, return last arg. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
674 if (target_type == Lisp_Cons && EQ (val, Qnil)) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
675 return last_tail; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
676 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
677 /* Copy the contents of the args into the result. */ |
211 | 678 if (CONSP (val)) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
679 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ |
211 | 680 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
681 toindex = 0, toindex_byte = 0; |
211 | 682 |
683 prev = Qnil; | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
684 if (STRINGP (val)) |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
685 textprops |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
686 = (struct textprop_rec *) alloca (sizeof (struct textprop_rec) * nargs); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
687 |
211 | 688 for (argnum = 0; argnum < nargs; argnum++) |
689 { | |
690 Lisp_Object thislen; | |
691 int thisleni; | |
16863
591b7a95d7a5
(concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents:
16561
diff
changeset
|
692 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
|
693 register unsigned int thisindex_byte = 0; |
211 | 694 |
695 this = args[argnum]; | |
696 if (!CONSP (this)) | |
697 thislen = Flength (this), thisleni = XINT (thislen); | |
698 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
699 /* 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
|
700 if (STRINGP (this) && STRINGP (val) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
701 && 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
|
702 { |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
703 int thislen_byte = STRING_BYTES (XSTRING (this)); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
704 int combined; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
705 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
706 bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte, |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
707 STRING_BYTES (XSTRING (this))); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
708 combined = (some_multibyte && toindex_byte > 0 |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
709 ? count_combining (XSTRING (val)->data, |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
710 toindex_byte + thislen_byte, |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
711 toindex_byte) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
712 : 0); |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
713 if (! NULL_INTERVAL_P (XSTRING (this)->intervals)) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
714 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
715 textprops[num_textprops].argnum = argnum; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
716 /* We ignore text properties on characters being combined. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
717 textprops[num_textprops].from = combined; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
718 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
719 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
720 toindex_byte += thislen_byte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
721 toindex += thisleni - combined; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
722 XSTRING (val)->size -= combined; |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
723 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
724 /* Copy a single-byte string to a multibyte string. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
725 else if (STRINGP (this) && STRINGP (val)) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
726 { |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
727 if (! NULL_INTERVAL_P (XSTRING (this)->intervals)) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
728 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
729 textprops[num_textprops].argnum = argnum; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
730 textprops[num_textprops].from = 0; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
731 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
732 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
733 toindex_byte += copy_text (XSTRING (this)->data, |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
734 XSTRING (val)->data + toindex_byte, |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
735 XSTRING (this)->size, 0, 1); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
736 toindex += thisleni; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
737 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
738 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
739 /* Copy element by element. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
740 while (1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
741 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
742 register Lisp_Object elt; |
211 | 743 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
744 /* 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
|
745 `this' is exhausted. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
746 if (NILP (this)) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
747 if (CONSP (this)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
748 elt = XCONS (this)->car, this = XCONS (this)->cdr; |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
749 else if (thisindex >= thisleni) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
750 break; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
751 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
752 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
753 int c; |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
754 if (STRING_MULTIBYTE (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
755 { |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
756 FETCH_STRING_CHAR_ADVANCE (c, this, |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
757 thisindex, |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
758 thisindex_byte); |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
759 XSETFASTINT (elt, c); |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
760 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
761 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
762 { |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
763 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]); |
23152
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
764 if (some_multibyte |
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
765 && (XINT (elt) >= 0240 |
23927
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
766 || (XINT (elt) >= 0200 |
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
767 && ! NILP (Vnonascii_translation_table))) |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
768 && XINT (elt) < 0400) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
769 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
770 c = unibyte_char_to_multibyte (XINT (elt)); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
771 XSETINT (elt, c); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
772 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
773 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
774 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
775 else if (BOOL_VECTOR_P (this)) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
776 { |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
777 int byte; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
778 byte = XBOOL_VECTOR (this)->data[thisindex / BITS_PER_CHAR]; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
779 if (byte & (1 << (thisindex % BITS_PER_CHAR))) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
780 elt = Qt; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
781 else |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
782 elt = Qnil; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
783 thisindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
784 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
785 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
786 elt = XVECTOR (this)->contents[thisindex++]; |
211 | 787 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
788 /* 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
|
789 if (toindex < 0) |
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 XCONS (tail)->car = elt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
792 prev = tail; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
793 tail = XCONS (tail)->cdr; |
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 else if (VECTORP (val)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
796 XVECTOR (val)->contents[toindex++] = elt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
797 else |
211 | 798 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
799 CHECK_NUMBER (elt, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
800 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
|
801 { |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
802 XSTRING (val)->data[toindex_byte++] = XINT (elt); |
22696
56847e28cc45
(concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22165
diff
changeset
|
803 if (some_multibyte |
56847e28cc45
(concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22165
diff
changeset
|
804 && toindex_byte > 0 |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
805 && count_combining (XSTRING (val)->data, |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
806 toindex_byte, toindex_byte - 1)) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
807 XSTRING (val)->size--; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
808 else |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
809 toindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
810 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
811 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
812 /* 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
|
813 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
|
814 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
815 int c = XINT (elt); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
816 unsigned char work[4], *str; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
817 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
|
818 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
819 /* P exists as a variable |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
820 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
|
821 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
|
822 bcopy (str, p, i); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
823 toindex_byte += i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
824 toindex++; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
825 } |
211 | 826 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
827 } |
211 | 828 } |
485 | 829 if (!NILP (prev)) |
211 | 830 XCONS (prev)->cdr = last_tail; |
831 | |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
832 if (num_textprops > 0) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
833 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
834 for (argnum = 0; argnum < num_textprops; argnum++) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
835 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
836 this = args[textprops[argnum].argnum]; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
837 copy_text_properties (make_number (textprops[argnum].from), |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
838 XSTRING (this)->size, this, |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
839 make_number (textprops[argnum].to), val, Qnil); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
840 } |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
841 } |
20004 | 842 return val; |
211 | 843 } |
844 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
845 static Lisp_Object string_char_byte_cache_string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
846 static int string_char_byte_cache_charpos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
847 static int string_char_byte_cache_bytepos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
848 |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
849 void |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
850 clear_string_char_byte_cache () |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
851 { |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
852 string_char_byte_cache_string = Qnil; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
853 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
854 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
855 /* 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
|
856 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
857 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
858 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
|
859 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
860 int char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
861 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
862 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
863 int best_below, best_below_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
864 int best_above, best_above_byte; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
865 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
866 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
867 return char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
868 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
869 best_below = best_below_byte = 0; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
870 best_above = XSTRING (string)->size; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
871 best_above_byte = STRING_BYTES (XSTRING (string)); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
872 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
873 if (EQ (string, string_char_byte_cache_string)) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
874 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
875 if (string_char_byte_cache_charpos < char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
876 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
877 best_below = string_char_byte_cache_charpos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
878 best_below_byte = string_char_byte_cache_bytepos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
879 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
880 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
881 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
882 best_above = string_char_byte_cache_charpos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
883 best_above_byte = string_char_byte_cache_bytepos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
884 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
885 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
886 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
887 if (char_index - best_below < best_above - char_index) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
888 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
889 while (best_below < char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
890 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
891 int c; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
892 FETCH_STRING_CHAR_ADVANCE (c, string, best_below, best_below_byte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
893 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
894 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
895 i_byte = best_below_byte; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
896 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
897 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
898 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
899 while (best_above > char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
900 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
901 int best_above_byte_saved = --best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
902 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
903 while (best_above_byte > 0 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
904 && !CHAR_HEAD_P (XSTRING (string)->data[best_above_byte])) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
905 best_above_byte--; |
23877
2d62a1611751
(string_char_to_byte): Handle invalid multibyte sequence
Kenichi Handa <handa@m17n.org>
parents:
23817
diff
changeset
|
906 if (!BASE_LEADING_CODE_P (XSTRING (string)->data[best_above_byte])) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
907 best_above_byte = best_above_byte_saved; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
908 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
909 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
910 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
911 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
912 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
913 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
914 string_char_byte_cache_bytepos = i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
915 string_char_byte_cache_charpos = i; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
916 string_char_byte_cache_string = string; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
917 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
918 return i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
919 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
920 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
921 /* 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
|
922 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
923 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
924 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
|
925 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
926 int byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
927 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
928 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
929 int best_below, best_below_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
930 int best_above, best_above_byte; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
931 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
932 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
933 return byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
934 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
935 best_below = best_below_byte = 0; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
936 best_above = XSTRING (string)->size; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
937 best_above_byte = STRING_BYTES (XSTRING (string)); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
938 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
939 if (EQ (string, string_char_byte_cache_string)) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
940 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
941 if (string_char_byte_cache_bytepos < byte_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
942 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
943 best_below = string_char_byte_cache_charpos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
944 best_below_byte = string_char_byte_cache_bytepos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
945 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
946 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
947 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
948 best_above = string_char_byte_cache_charpos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
949 best_above_byte = string_char_byte_cache_bytepos; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
950 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
951 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
952 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
953 if (byte_index - best_below_byte < best_above_byte - byte_index) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
954 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
955 while (best_below_byte < byte_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
956 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
957 int c; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
958 FETCH_STRING_CHAR_ADVANCE (c, string, best_below, best_below_byte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
959 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
960 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
961 i_byte = best_below_byte; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
962 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
963 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
964 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
965 while (best_above_byte > byte_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
966 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
967 int best_above_byte_saved = --best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
968 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
969 while (best_above_byte > 0 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
970 && !CHAR_HEAD_P (XSTRING (string)->data[best_above_byte])) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
971 best_above_byte--; |
23877
2d62a1611751
(string_char_to_byte): Handle invalid multibyte sequence
Kenichi Handa <handa@m17n.org>
parents:
23817
diff
changeset
|
972 if (!BASE_LEADING_CODE_P (XSTRING (string)->data[best_above_byte])) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
973 best_above_byte = best_above_byte_saved; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
974 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
975 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
976 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
977 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
978 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
979 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
980 string_char_byte_cache_bytepos = i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
981 string_char_byte_cache_charpos = i; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
982 string_char_byte_cache_string = string; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
983 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
984 return i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
985 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
986 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
987 /* Convert STRING to a multibyte string. |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
988 Single-byte characters 0240 through 0377 are converted |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
989 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
|
990 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
991 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
992 string_make_multibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
993 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
994 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
995 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
996 int nbytes; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
997 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
998 if (STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
999 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1000 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1001 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
|
1002 XSTRING (string)->size); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1003 /* If all the chars are ASCII, they won't need any more bytes |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1004 once converted. In that case, we can return STRING itself. */ |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1005 if (nbytes == STRING_BYTES (XSTRING (string))) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1006 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1007 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1008 buf = (unsigned char *) alloca (nbytes); |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1009 copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)), |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1010 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1011 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1012 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
|
1013 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1014 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1015 /* 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
|
1016 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1017 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1018 string_make_unibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1019 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1020 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1021 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1022 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1023 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1024 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1025 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1026 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
|
1027 |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1028 copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)), |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1029 1, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1030 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1031 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
|
1032 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1033 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1034 DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte, |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1035 1, 1, 0, |
21716
254857cf599c
(Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21673
diff
changeset
|
1036 "Return the multibyte equivalent of STRING.\n\ |
254857cf599c
(Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21673
diff
changeset
|
1037 The function `unibyte-char-to-multibyte' is used to convert\n\ |
254857cf599c
(Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21673
diff
changeset
|
1038 each unibyte character to a multibyte character.") |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1039 (string) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1040 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1041 { |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1042 CHECK_STRING (string, 0); |
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1043 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1044 return string_make_multibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1045 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1046 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1047 DEFUN ("string-make-unibyte", Fstring_make_unibyte, Sstring_make_unibyte, |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1048 1, 1, 0, |
21716
254857cf599c
(Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21673
diff
changeset
|
1049 "Return the unibyte equivalent of STRING.\n\ |
254857cf599c
(Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21673
diff
changeset
|
1050 Multibyte character codes are converted to unibyte\n\ |
254857cf599c
(Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
21673
diff
changeset
|
1051 by using just the low 8 bits.") |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1052 (string) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1053 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1054 { |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1055 CHECK_STRING (string, 0); |
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1056 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1057 return string_make_unibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1058 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1059 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1060 DEFUN ("string-as-unibyte", Fstring_as_unibyte, Sstring_as_unibyte, |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1061 1, 1, 0, |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1062 "Return a unibyte string with the same individual bytes as STRING.\n\ |
23773
f11f551fee99
(Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents:
23733
diff
changeset
|
1063 If STRING is unibyte, the result is STRING itself.\n\ |
f11f551fee99
(Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents:
23733
diff
changeset
|
1064 Otherwise it is a newly created string, with no text properties.") |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1065 (string) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1066 Lisp_Object string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1067 { |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1068 CHECK_STRING (string, 0); |
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1069 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1070 if (STRING_MULTIBYTE (string)) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1071 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1072 string = Fcopy_sequence (string); |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1073 XSTRING (string)->size = STRING_BYTES (XSTRING (string)); |
23773
f11f551fee99
(Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents:
23733
diff
changeset
|
1074 XSTRING (string)->intervals = NULL_INTERVAL; |
21374
456146137d23
(Fstring_as_unibyte): Set size_byte field to -1.
Kenichi Handa <handa@m17n.org>
parents:
21342
diff
changeset
|
1075 SET_STRING_BYTES (XSTRING (string), -1); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1076 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1077 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1078 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1079 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1080 DEFUN ("string-as-multibyte", Fstring_as_multibyte, Sstring_as_multibyte, |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1081 1, 1, 0, |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1082 "Return a multibyte string with the same individual bytes as STRING.\n\ |
23773
f11f551fee99
(Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents:
23733
diff
changeset
|
1083 If STRING is multibyte, the result is STRING itself.\n\ |
f11f551fee99
(Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents:
23733
diff
changeset
|
1084 Otherwise it is a newly created string, with no text properties.") |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1085 (string) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1086 Lisp_Object string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1087 { |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1088 CHECK_STRING (string, 0); |
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1089 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1090 if (! STRING_MULTIBYTE (string)) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1091 { |
21342
efdf4fe4875b
(Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents:
21339
diff
changeset
|
1092 int nbytes = STRING_BYTES (XSTRING (string)); |
efdf4fe4875b
(Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents:
21339
diff
changeset
|
1093 int newlen = multibyte_chars_in_text (XSTRING (string)->data, nbytes); |
efdf4fe4875b
(Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents:
21339
diff
changeset
|
1094 |
efdf4fe4875b
(Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents:
21339
diff
changeset
|
1095 string = Fcopy_sequence (string); |
efdf4fe4875b
(Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents:
21339
diff
changeset
|
1096 XSTRING (string)->size = newlen; |
efdf4fe4875b
(Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents:
21339
diff
changeset
|
1097 XSTRING (string)->size_byte = nbytes; |
23773
f11f551fee99
(Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents:
23733
diff
changeset
|
1098 XSTRING (string)->intervals = NULL_INTERVAL; |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1099 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1100 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1101 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1102 |
211 | 1103 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0, |
1104 "Return a copy of ALIST.\n\ | |
1105 This is an alist which represents the same mapping from objects to objects,\n\ | |
1106 but does not share the alist structure with ALIST.\n\ | |
1107 The objects mapped (cars and cdrs of elements of the alist)\n\ | |
1108 are shared, however.\n\ | |
1109 Elements of ALIST that are not conses are also shared.") | |
1110 (alist) | |
1111 Lisp_Object alist; | |
1112 { | |
1113 register Lisp_Object tem; | |
1114 | |
1115 CHECK_LIST (alist, 0); | |
485 | 1116 if (NILP (alist)) |
211 | 1117 return alist; |
1118 alist = concat (1, &alist, Lisp_Cons, 0); | |
1119 for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr) | |
1120 { | |
1121 register Lisp_Object car; | |
1122 car = XCONS (tem)->car; | |
1123 | |
1124 if (CONSP (car)) | |
1125 XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr); | |
1126 } | |
1127 return alist; | |
1128 } | |
1129 | |
1130 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, | |
1131 "Return a substring of STRING, starting at index FROM and ending before TO.\n\ | |
1132 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
|
1133 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
|
1134 \n\ |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1135 This function allows vectors as well as strings.") |
211 | 1136 (string, from, to) |
1137 Lisp_Object string; | |
1138 register Lisp_Object from, to; | |
1139 { | |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1140 Lisp_Object res; |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1141 int size; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1142 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1143 int from_char, to_char; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1144 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
|
1145 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1146 if (! (STRINGP (string) || VECTORP (string))) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1147 wrong_type_argument (Qarrayp, string); |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1148 |
211 | 1149 CHECK_NUMBER (from, 1); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1150 |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1151 if (STRINGP (string)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1152 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1153 size = XSTRING (string)->size; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1154 size_byte = STRING_BYTES (XSTRING (string)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1155 } |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1156 else |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1157 size = XVECTOR (string)->size; |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1158 |
485 | 1159 if (NILP (to)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1160 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1161 to_char = size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1162 to_byte = size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1163 } |
211 | 1164 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1165 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1166 CHECK_NUMBER (to, 2); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1167 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1168 to_char = XINT (to); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1169 if (to_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1170 to_char += size; |
211 | 1171 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1172 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1173 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
|
1174 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1175 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1176 from_char = XINT (from); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1177 if (from_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1178 from_char += size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1179 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1180 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
|
1181 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1182 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
|
1183 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
|
1184 make_number (to_char)); |
211 | 1185 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1186 if (STRINGP (string)) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1187 { |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1188 res = make_specified_string (XSTRING (string)->data + from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1189 to_char - from_char, to_byte - from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1190 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1191 copy_text_properties (make_number (from_char), make_number (to_char), |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1192 string, make_number (0), res, Qnil); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1193 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1194 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1195 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
|
1196 XVECTOR (string)->contents + from_char); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1197 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1198 return res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1199 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1200 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1201 /* 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
|
1202 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
|
1203 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1204 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1205 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
|
1206 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1207 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
|
1208 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1209 Lisp_Object res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1210 int size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1211 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1212 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1213 if (! (STRINGP (string) || VECTORP (string))) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1214 wrong_type_argument (Qarrayp, string); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1215 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1216 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1217 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1218 size = XSTRING (string)->size; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1219 size_byte = STRING_BYTES (XSTRING (string)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1220 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1221 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1222 size = XVECTOR (string)->size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1223 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1224 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
|
1225 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
|
1226 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1227 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1228 { |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1229 res = make_specified_string (XSTRING (string)->data + from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1230 to - from, to_byte - from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1231 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1232 copy_text_properties (make_number (from), make_number (to), |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1233 string, make_number (0), res, Qnil); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1234 } |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1235 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1236 res = Fvector (to - from, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1237 XVECTOR (string)->contents + from); |
20004 | 1238 |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1239 return res; |
211 | 1240 } |
1241 | |
1242 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, | |
1243 "Take cdr N times on LIST, returns the result.") | |
1244 (n, list) | |
1245 Lisp_Object n; | |
1246 register Lisp_Object list; | |
1247 { | |
1248 register int i, num; | |
1249 CHECK_NUMBER (n, 0); | |
1250 num = XINT (n); | |
485 | 1251 for (i = 0; i < num && !NILP (list); i++) |
211 | 1252 { |
1253 QUIT; | |
1254 list = Fcdr (list); | |
1255 } | |
1256 return list; | |
1257 } | |
1258 | |
1259 DEFUN ("nth", Fnth, Snth, 2, 2, 0, | |
1260 "Return the Nth element of LIST.\n\ | |
1261 N counts from zero. If LIST is not that long, nil is returned.") | |
1262 (n, list) | |
1263 Lisp_Object n, list; | |
1264 { | |
1265 return Fcar (Fnthcdr (n, list)); | |
1266 } | |
1267 | |
1268 DEFUN ("elt", Felt, Selt, 2, 2, 0, | |
1269 "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
|
1270 (sequence, n) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1271 register Lisp_Object sequence, n; |
211 | 1272 { |
1273 CHECK_NUMBER (n, 0); | |
1274 while (1) | |
1275 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1276 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
|
1277 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
|
1278 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
|
1279 || 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
|
1280 return Faref (sequence, n); |
211 | 1281 else |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1282 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 1283 } |
1284 } | |
1285 | |
1286 DEFUN ("member", Fmember, Smember, 2, 2, 0, | |
6990 | 1287 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\ |
211 | 1288 The value is actually the tail of LIST whose car is ELT.") |
1289 (elt, list) | |
1290 register Lisp_Object elt; | |
1291 Lisp_Object list; | |
1292 { | |
1293 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
|
1294 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 1295 { |
1296 register Lisp_Object tem; | |
1297 tem = Fcar (tail); | |
485 | 1298 if (! NILP (Fequal (elt, tem))) |
211 | 1299 return tail; |
1300 QUIT; | |
1301 } | |
1302 return Qnil; | |
1303 } | |
1304 | |
1305 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | |
1306 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\ | |
1307 The value is actually the tail of LIST whose car is ELT.") | |
1308 (elt, list) | |
1309 register Lisp_Object elt; | |
1310 Lisp_Object list; | |
1311 { | |
1312 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
|
1313 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 1314 { |
1315 register Lisp_Object tem; | |
1316 tem = Fcar (tail); | |
1317 if (EQ (elt, tem)) return tail; | |
1318 QUIT; | |
1319 } | |
1320 return Qnil; | |
1321 } | |
1322 | |
1323 DEFUN ("assq", Fassq, Sassq, 2, 2, 0, | |
5661
066830a71a63
(Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
5437
diff
changeset
|
1324 "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
|
1325 The value is actually the element of LIST whose car is KEY.\n\ |
211 | 1326 Elements of LIST that are not conses are ignored.") |
1327 (key, list) | |
1328 register Lisp_Object key; | |
1329 Lisp_Object list; | |
1330 { | |
1331 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
|
1332 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 1333 { |
1334 register Lisp_Object elt, tem; | |
1335 elt = Fcar (tail); | |
1336 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
|
1337 tem = XCONS (elt)->car; |
211 | 1338 if (EQ (key, tem)) return elt; |
1339 QUIT; | |
1340 } | |
1341 return Qnil; | |
1342 } | |
1343 | |
1344 /* Like Fassq but never report an error and do not allow quits. | |
1345 Use only on lists known never to be circular. */ | |
1346 | |
1347 Lisp_Object | |
1348 assq_no_quit (key, list) | |
1349 register Lisp_Object key; | |
1350 Lisp_Object list; | |
1351 { | |
1352 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
|
1353 for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr) |
211 | 1354 { |
1355 register Lisp_Object elt, tem; | |
1356 elt = Fcar (tail); | |
1357 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
|
1358 tem = XCONS (elt)->car; |
211 | 1359 if (EQ (key, tem)) return elt; |
1360 } | |
1361 return Qnil; | |
1362 } | |
1363 | |
1364 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | |
5661
066830a71a63
(Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
5437
diff
changeset
|
1365 "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
|
1366 The value is actually the element of LIST whose car equals KEY.") |
211 | 1367 (key, list) |
1368 register Lisp_Object key; | |
1369 Lisp_Object list; | |
1370 { | |
1371 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
|
1372 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 1373 { |
1374 register Lisp_Object elt, tem; | |
1375 elt = Fcar (tail); | |
1376 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
|
1377 tem = Fequal (XCONS (elt)->car, key); |
485 | 1378 if (!NILP (tem)) return elt; |
211 | 1379 QUIT; |
1380 } | |
1381 return Qnil; | |
1382 } | |
1383 | |
1384 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, | |
1385 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\ | |
1386 The value is actually the element of LIST whose cdr is ELT.") | |
1387 (key, list) | |
1388 register Lisp_Object key; | |
1389 Lisp_Object list; | |
1390 { | |
1391 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
|
1392 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
211 | 1393 { |
1394 register Lisp_Object elt, tem; | |
1395 elt = Fcar (tail); | |
1396 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
|
1397 tem = XCONS (elt)->cdr; |
211 | 1398 if (EQ (key, tem)) return elt; |
1399 QUIT; | |
1400 } | |
1401 return Qnil; | |
1402 } | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1403 |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1404 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1405 "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
|
1406 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
|
1407 (key, list) |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1408 register Lisp_Object key; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1409 Lisp_Object list; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1410 { |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1411 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
|
1412 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr) |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1413 { |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1414 register Lisp_Object elt, tem; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1415 elt = Fcar (tail); |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1416 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
|
1417 tem = Fequal (XCONS (elt)->cdr, key); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1418 if (!NILP (tem)) return elt; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1419 QUIT; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1420 } |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1421 return Qnil; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1422 } |
211 | 1423 |
1424 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, | |
1425 "Delete by side effect any occurrences of ELT as a member of LIST.\n\ | |
1426 The modified LIST is returned. Comparison is done with `eq'.\n\ | |
1427 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\ | |
1428 therefore, write `(setq foo (delq element foo))'\n\ | |
1429 to be sure of changing the value of `foo'.") | |
1430 (elt, list) | |
1431 register Lisp_Object elt; | |
1432 Lisp_Object list; | |
1433 { | |
1434 register Lisp_Object tail, prev; | |
1435 register Lisp_Object tem; | |
1436 | |
1437 tail = list; | |
1438 prev = Qnil; | |
485 | 1439 while (!NILP (tail)) |
211 | 1440 { |
1441 tem = Fcar (tail); | |
1442 if (EQ (elt, tem)) | |
1443 { | |
485 | 1444 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
|
1445 list = XCONS (tail)->cdr; |
211 | 1446 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
|
1447 Fsetcdr (prev, XCONS (tail)->cdr); |
211 | 1448 } |
1449 else | |
1450 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
|
1451 tail = XCONS (tail)->cdr; |
211 | 1452 QUIT; |
1453 } | |
1454 return list; | |
1455 } | |
1456 | |
414 | 1457 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0, |
401 | 1458 "Delete by side effect any occurrences of ELT as a member of LIST.\n\ |
1459 The modified LIST is returned. Comparison is done with `equal'.\n\ | |
6990 | 1460 If the first member of LIST is ELT, deleting it is not a side effect;\n\ |
1461 it is simply using a different list.\n\ | |
1462 Therefore, write `(setq foo (delete element foo))'\n\ | |
401 | 1463 to be sure of changing the value of `foo'.") |
1464 (elt, list) | |
1465 register Lisp_Object elt; | |
1466 Lisp_Object list; | |
1467 { | |
1468 register Lisp_Object tail, prev; | |
1469 register Lisp_Object tem; | |
1470 | |
1471 tail = list; | |
1472 prev = Qnil; | |
485 | 1473 while (!NILP (tail)) |
401 | 1474 { |
1475 tem = Fcar (tail); | |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
1476 if (! NILP (Fequal (elt, tem))) |
401 | 1477 { |
485 | 1478 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
|
1479 list = XCONS (tail)->cdr; |
401 | 1480 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
|
1481 Fsetcdr (prev, XCONS (tail)->cdr); |
401 | 1482 } |
1483 else | |
1484 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
|
1485 tail = XCONS (tail)->cdr; |
401 | 1486 QUIT; |
1487 } | |
1488 return list; | |
1489 } | |
1490 | |
211 | 1491 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0, |
1492 "Reverse LIST by modifying cdr pointers.\n\ | |
1493 Returns the beginning of the reversed list.") | |
1494 (list) | |
1495 Lisp_Object list; | |
1496 { | |
1497 register Lisp_Object prev, tail, next; | |
1498 | |
485 | 1499 if (NILP (list)) return list; |
211 | 1500 prev = Qnil; |
1501 tail = list; | |
485 | 1502 while (!NILP (tail)) |
211 | 1503 { |
1504 QUIT; | |
1505 next = Fcdr (tail); | |
1506 Fsetcdr (tail, prev); | |
1507 prev = tail; | |
1508 tail = next; | |
1509 } | |
1510 return prev; | |
1511 } | |
1512 | |
1513 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, | |
1514 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\ | |
1515 See also the function `nreverse', which is used more often.") | |
1516 (list) | |
1517 Lisp_Object list; | |
1518 { | |
18421 | 1519 Lisp_Object new; |
211 | 1520 |
18421 | 1521 for (new = Qnil; CONSP (list); list = XCONS (list)->cdr) |
1522 new = Fcons (XCONS (list)->car, new); | |
1523 if (!NILP (list)) | |
1524 wrong_type_argument (Qconsp, list); | |
1525 return new; | |
211 | 1526 } |
1527 | |
1528 Lisp_Object merge (); | |
1529 | |
1530 DEFUN ("sort", Fsort, Ssort, 2, 2, 0, | |
1531 "Sort LIST, stably, comparing elements using PREDICATE.\n\ | |
1532 Returns the sorted list. LIST is modified by side effects.\n\ | |
1533 PREDICATE is called with two elements of LIST, and should return T\n\ | |
1534 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
|
1535 (list, predicate) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1536 Lisp_Object list, predicate; |
211 | 1537 { |
1538 Lisp_Object front, back; | |
1539 register Lisp_Object len, tem; | |
1540 struct gcpro gcpro1, gcpro2; | |
1541 register int length; | |
1542 | |
1543 front = list; | |
1544 len = Flength (list); | |
1545 length = XINT (len); | |
1546 if (length < 2) | |
1547 return list; | |
1548 | |
1549 XSETINT (len, (length / 2) - 1); | |
1550 tem = Fnthcdr (len, list); | |
1551 back = Fcdr (tem); | |
1552 Fsetcdr (tem, Qnil); | |
1553 | |
1554 GCPRO2 (front, back); | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1555 front = Fsort (front, predicate); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1556 back = Fsort (back, predicate); |
211 | 1557 UNGCPRO; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1558 return merge (front, back, predicate); |
211 | 1559 } |
1560 | |
1561 Lisp_Object | |
1562 merge (org_l1, org_l2, pred) | |
1563 Lisp_Object org_l1, org_l2; | |
1564 Lisp_Object pred; | |
1565 { | |
1566 Lisp_Object value; | |
1567 register Lisp_Object tail; | |
1568 Lisp_Object tem; | |
1569 register Lisp_Object l1, l2; | |
1570 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1571 | |
1572 l1 = org_l1; | |
1573 l2 = org_l2; | |
1574 tail = Qnil; | |
1575 value = Qnil; | |
1576 | |
1577 /* It is sufficient to protect org_l1 and org_l2. | |
1578 When l1 and l2 are updated, we copy the new values | |
1579 back into the org_ vars. */ | |
1580 GCPRO4 (org_l1, org_l2, pred, value); | |
1581 | |
1582 while (1) | |
1583 { | |
485 | 1584 if (NILP (l1)) |
211 | 1585 { |
1586 UNGCPRO; | |
485 | 1587 if (NILP (tail)) |
211 | 1588 return l2; |
1589 Fsetcdr (tail, l2); | |
1590 return value; | |
1591 } | |
485 | 1592 if (NILP (l2)) |
211 | 1593 { |
1594 UNGCPRO; | |
485 | 1595 if (NILP (tail)) |
211 | 1596 return l1; |
1597 Fsetcdr (tail, l1); | |
1598 return value; | |
1599 } | |
1600 tem = call2 (pred, Fcar (l2), Fcar (l1)); | |
485 | 1601 if (NILP (tem)) |
211 | 1602 { |
1603 tem = l1; | |
1604 l1 = Fcdr (l1); | |
1605 org_l1 = l1; | |
1606 } | |
1607 else | |
1608 { | |
1609 tem = l2; | |
1610 l2 = Fcdr (l2); | |
1611 org_l2 = l2; | |
1612 } | |
485 | 1613 if (NILP (tail)) |
211 | 1614 value = tem; |
1615 else | |
1616 Fsetcdr (tail, tem); | |
1617 tail = tem; | |
1618 } | |
1619 } | |
1620 | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1621 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1622 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
|
1623 "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
|
1624 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
|
1625 \(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
|
1626 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
|
1627 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
|
1628 (plist, prop) |
7f7e97f219ce
(Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents:
13862
diff
changeset
|
1629 Lisp_Object plist; |
211 | 1630 register Lisp_Object prop; |
1631 { | |
1632 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
|
1633 for (tail = plist; !NILP (tail); tail = Fcdr (XCONS (tail)->cdr)) |
211 | 1634 { |
1635 register Lisp_Object tem; | |
1636 tem = Fcar (tail); | |
1637 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
|
1638 return Fcar (XCONS (tail)->cdr); |
211 | 1639 } |
1640 return Qnil; | |
1641 } | |
1642 | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1643 DEFUN ("get", Fget, Sget, 2, 2, 0, |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1644 "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
|
1645 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
|
1646 (symbol, propname) |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1647 Lisp_Object symbol, propname; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1648 { |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1649 CHECK_SYMBOL (symbol, 0); |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1650 return Fplist_get (XSYMBOL (symbol)->plist, propname); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1651 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1652 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1653 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
|
1654 "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
|
1655 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
|
1656 \(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
|
1657 If PROP is already a property on the list, its value is set to VAL,\n\ |
11221 | 1658 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
|
1659 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
|
1660 The PLIST is modified by side effects.") |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1661 (plist, prop, val) |
20004 | 1662 Lisp_Object plist; |
1663 register Lisp_Object prop; | |
1664 Lisp_Object val; | |
211 | 1665 { |
1666 register Lisp_Object tail, prev; | |
1667 Lisp_Object newcell; | |
1668 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
|
1669 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
|
1670 tail = XCONS (XCONS (tail)->cdr)->cdr) |
211 | 1671 { |
11539
d8227796a997
(Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents:
11240
diff
changeset
|
1672 if (EQ (prop, XCONS (tail)->car)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1673 { |
11539
d8227796a997
(Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents:
11240
diff
changeset
|
1674 Fsetcar (XCONS (tail)->cdr, val); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1675 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1676 } |
211 | 1677 prev = tail; |
1678 } | |
1679 newcell = Fcons (prop, Fcons (val, Qnil)); | |
485 | 1680 if (NILP (prev)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1681 return newcell; |
211 | 1682 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
|
1683 Fsetcdr (XCONS (prev)->cdr, newcell); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1684 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1685 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1686 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1687 DEFUN ("put", Fput, Sput, 3, 3, 0, |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1688 "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
|
1689 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
|
1690 (symbol, propname, value) |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1691 Lisp_Object symbol, propname, value; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1692 { |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1693 CHECK_SYMBOL (symbol, 0); |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1694 XSYMBOL (symbol)->plist |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1695 = 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
|
1696 return value; |
211 | 1697 } |
1698 | |
1699 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
|
1700 "Return t if two Lisp objects have similar structure and contents.\n\ |
211 | 1701 They must have the same data type.\n\ |
1702 Conses are compared by comparing the cars and the cdrs.\n\ | |
1703 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
|
1704 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
|
1705 (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
|
1706 Symbols must match exactly.") |
211 | 1707 (o1, o2) |
1708 register Lisp_Object o1, o2; | |
1709 { | |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1710 return internal_equal (o1, o2, 0) ? Qt : Qnil; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1711 } |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1712 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1713 static int |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1714 internal_equal (o1, o2, depth) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1715 register Lisp_Object o1, o2; |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1716 int depth; |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1717 { |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1718 if (depth > 200) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
1719 error ("Stack overflow in equal"); |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1720 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1721 tail_recurse: |
211 | 1722 QUIT; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1723 if (EQ (o1, o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1724 return 1; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1725 if (XTYPE (o1) != XTYPE (o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1726 return 0; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1727 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1728 switch (XTYPE (o1)) |
211 | 1729 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1730 #ifdef LISP_FLOAT_TYPE |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1731 case Lisp_Float: |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1732 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
|
1733 #endif |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1734 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1735 case Lisp_Cons: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1736 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
|
1737 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1738 o1 = XCONS (o1)->cdr; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1739 o2 = XCONS (o2)->cdr; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1740 goto tail_recurse; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1741 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1742 case Lisp_Misc: |
11240
2642924d2d21
(internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1743 if (XMISCTYPE (o1) != XMISCTYPE (o2)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1744 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1745 if (OVERLAYP (o1)) |
211 | 1746 { |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
1747 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2), |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1748 depth + 1) |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
1749 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1750 depth + 1)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1751 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1752 o1 = XOVERLAY (o1)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1753 o2 = XOVERLAY (o2)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1754 goto tail_recurse; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1755 } |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1756 if (MARKERP (o1)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1757 { |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1758 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
|
1759 && (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
|
1760 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); |
211 | 1761 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1762 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1763 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1764 case Lisp_Vectorlike: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1765 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1766 register int i, size; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1767 size = XVECTOR (o1)->size; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1768 /* 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
|
1769 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
|
1770 same size. */ |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1771 if (XVECTOR (o2)->size != size) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1772 return 0; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1773 /* Boolvectors are compared much like strings. */ |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1774 if (BOOL_VECTOR_P (o1)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1775 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1776 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
1777 = (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
|
1778 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1779 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
|
1780 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1781 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
|
1782 size_in_chars)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1783 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1784 return 1; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1785 } |
20776
219fdecc30d3
(internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents:
20712
diff
changeset
|
1786 if (WINDOW_CONFIGURATIONP (o1)) |
21021
7be2384fabdc
(internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents:
20992
diff
changeset
|
1787 return compare_window_configurations (o1, o2, 0); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1788 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1789 /* 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
|
1790 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
|
1791 if (size & PSEUDOVECTOR_FLAG) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1792 { |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1793 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1794 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1795 size &= PSEUDOVECTOR_SIZE_MASK; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1796 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1797 for (i = 0; i < size; i++) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1798 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1799 Lisp_Object v1, v2; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1800 v1 = XVECTOR (o1)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1801 v2 = XVECTOR (o2)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1802 if (!internal_equal (v1, v2, depth + 1)) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1803 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1804 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1805 return 1; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1806 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1807 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1808 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
1809 case Lisp_String: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1810 if (XSTRING (o1)->size != XSTRING (o2)->size) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1811 return 0; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1812 if (STRING_BYTES (XSTRING (o1)) != STRING_BYTES (XSTRING (o2))) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1813 return 0; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1814 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
1815 STRING_BYTES (XSTRING (o1)))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1816 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
1817 return 1; |
211 | 1818 } |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
1819 return 0; |
211 | 1820 } |
1821 | |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
1822 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
|
1823 |
211 | 1824 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
|
1825 "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
|
1826 ARRAY is a vector, string, char-table, or bool-vector.") |
211 | 1827 (array, item) |
1828 Lisp_Object array, item; | |
1829 { | |
1830 register int size, index, charval; | |
1831 retry: | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
1832 if (VECTORP (array)) |
211 | 1833 { |
1834 register Lisp_Object *p = XVECTOR (array)->contents; | |
1835 size = XVECTOR (array)->size; | |
1836 for (index = 0; index < size; index++) | |
1837 p[index] = item; | |
1838 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1839 else if (CHAR_TABLE_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1840 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1841 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
|
1842 size = CHAR_TABLE_ORDINARY_SLOTS; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1843 for (index = 0; index < size; index++) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1844 p[index] = item; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1845 XCHAR_TABLE (array)->defalt = Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1846 } |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
1847 else if (STRINGP (array)) |
211 | 1848 { |
1849 register unsigned char *p = XSTRING (array)->data; | |
1850 CHECK_NUMBER (item, 1); | |
1851 charval = XINT (item); | |
1852 size = XSTRING (array)->size; | |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1853 if (STRING_MULTIBYTE (array)) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1854 { |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1855 unsigned char workbuf[4], *str; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1856 int len = CHAR_STRING (charval, workbuf, str); |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1857 int size_byte = STRING_BYTES (XSTRING (array)); |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1858 unsigned char *p1 = p, *endp = p + size_byte; |
23453
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1859 int i; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1860 |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1861 if (size != size_byte) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1862 while (p1 < endp) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1863 { |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1864 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1865 if (len != this_len) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1866 error ("Attempt to change byte length of a string"); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1867 p1 += this_len; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
1868 } |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1869 for (i = 0; i < size_byte; i++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1870 *p++ = str[i % len]; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1871 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1872 else |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1873 for (index = 0; index < size; index++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
1874 p[index] = charval; |
211 | 1875 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1876 else if (BOOL_VECTOR_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1877 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1878 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
|
1879 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
1880 = (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
|
1881 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1882 charval = (! NILP (item) ? -1 : 0); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1883 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
|
1884 p[index] = charval; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1885 } |
211 | 1886 else |
1887 { | |
1888 array = wrong_type_argument (Qarrayp, array); | |
1889 goto retry; | |
1890 } | |
1891 return array; | |
1892 } | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1893 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1894 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
|
1895 1, 1, 0, |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1896 "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
|
1897 (char_table) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1898 Lisp_Object char_table; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1899 { |
20004 | 1900 CHECK_CHAR_TABLE (char_table, 0); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1901 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1902 return XCHAR_TABLE (char_table)->purpose; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1903 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1904 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1905 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
|
1906 1, 1, 0, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1907 "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
|
1908 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
|
1909 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
|
1910 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
|
1911 \(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
|
1912 (char_table) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1913 Lisp_Object char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1914 { |
20004 | 1915 CHECK_CHAR_TABLE (char_table, 0); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1916 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1917 return XCHAR_TABLE (char_table)->parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1918 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1919 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1920 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
|
1921 2, 2, 0, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1922 "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
|
1923 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
|
1924 (char_table, parent) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1925 Lisp_Object char_table, parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1926 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1927 Lisp_Object temp; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1928 |
20004 | 1929 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
|
1930 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1931 if (!NILP (parent)) |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1932 { |
20004 | 1933 CHECK_CHAR_TABLE (parent, 0); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1934 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
1935 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
|
1936 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
|
1937 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
|
1938 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1939 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1940 XCHAR_TABLE (char_table)->parent = parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1941 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1942 return parent; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1943 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1944 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1945 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
|
1946 2, 2, 0, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
1947 "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
|
1948 (char_table, n) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1949 Lisp_Object char_table, n; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1950 { |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1951 CHECK_CHAR_TABLE (char_table, 1); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1952 CHECK_NUMBER (n, 2); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1953 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
|
1954 || 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
|
1955 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
|
1956 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1957 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
|
1958 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1959 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1960 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
|
1961 Sset_char_table_extra_slot, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1962 3, 3, 0, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
1963 "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
|
1964 (char_table, n, value) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1965 Lisp_Object char_table, n, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1966 { |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1967 CHECK_CHAR_TABLE (char_table, 1); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1968 CHECK_NUMBER (n, 2); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
1969 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
|
1970 || 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
|
1971 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
|
1972 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1973 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
|
1974 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1975 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1976 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
|
1977 2, 2, 0, |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1978 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\ |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1979 RANGE should be nil (for the default value)\n\ |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1980 a vector which identifies a character set or a row of a character set,\n\ |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1981 a character set name, 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
|
1982 (char_table, range) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1983 Lisp_Object char_table, range; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1984 { |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1985 int i; |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1986 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1987 CHECK_CHAR_TABLE (char_table, 0); |
20004 | 1988 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1989 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
|
1990 return XCHAR_TABLE (char_table)->defalt; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
1991 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
|
1992 return Faref (char_table, range); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1993 else if (SYMBOLP (range)) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1994 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1995 Lisp_Object charset_info; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1996 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1997 charset_info = Fget (range, Qcharset); |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1998 CHECK_VECTOR (charset_info, 0); |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1999 |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2000 return Faref (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2001 make_number (XINT (XVECTOR (charset_info)->contents[0]) |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2002 + 128)); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2003 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2004 else if (VECTORP (range)) |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2005 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2006 if (XVECTOR (range)->size == 1) |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2007 return Faref (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2008 make_number (XINT (XVECTOR (range)->contents[0]) + 128)); |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2009 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2010 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2011 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2012 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2013 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
|
2014 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2015 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2016 return Faref (char_table, ch); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2017 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2018 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2019 else |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2020 error ("Invalid RANGE argument to `char-table-range'"); |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2021 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2022 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2023 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
|
2024 3, 3, 0, |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2025 "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
|
2026 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
|
2027 a vector which identifies a character set or a row of a character set,\n\ |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2028 a coding system, 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
|
2029 (char_table, range, value) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2030 Lisp_Object char_table, range, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2031 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2032 int i; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2033 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2034 CHECK_CHAR_TABLE (char_table, 0); |
20004 | 2035 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2036 if (EQ (range, Qt)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2037 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
|
2038 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
|
2039 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
|
2040 XCHAR_TABLE (char_table)->defalt = value; |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2041 else if (SYMBOLP (range)) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2042 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2043 Lisp_Object charset_info; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2044 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2045 charset_info = Fget (range, Qcharset); |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2046 CHECK_VECTOR (charset_info, 0); |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2047 |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2048 return Faset (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2049 make_number (XINT (XVECTOR (charset_info)->contents[0]) |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2050 + 128), |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2051 value); |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2052 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2053 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
|
2054 Faset (char_table, range, value); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2055 else if (VECTORP (range)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2056 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2057 if (XVECTOR (range)->size == 1) |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2058 return Faset (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2059 make_number (XINT (XVECTOR (range)->contents[0]) + 128), |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2060 value); |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2061 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2062 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2063 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2064 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2065 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
|
2066 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2067 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2068 return Faset (char_table, ch, value); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2069 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2070 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2071 else |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2072 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
|
2073 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2074 return value; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2075 } |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2076 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2077 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
|
2078 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
|
2079 "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
|
2080 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
|
2081 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
|
2082 (char_table, ch, value) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2083 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
|
2084 { |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2085 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
|
2086 Lisp_Object temp; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2087 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2088 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
|
2089 CHECK_NUMBER (ch, 1); |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2090 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2091 c = XINT (ch); |
24255
c373e786127a
(Fset_char_table_default): To handle the case that CH is
Kenichi Handa <handa@m17n.org>
parents:
24016
diff
changeset
|
2092 SPLIT_CHAR (c, charset, code1, code2); |
22701
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2093 |
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2094 /* Since we may want to set the default value for a character set |
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2095 not yet defined, we check only if the character set is in the |
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2096 valid range or not, instead of it is already defined or not. */ |
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2097 if (! CHARSET_VALID_P (charset)) |
22706 | 2098 invalid_character (c); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2099 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2100 if (charset == CHARSET_ASCII) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2101 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
|
2102 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2103 /* 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
|
2104 generic char is specified. */ |
22701
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2105 if (charset == CHARSET_COMPOSITION || CHARSET_DIMENSION (charset) == 1) |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2106 code1 = 0; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2107 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
|
2108 if (!code1) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2109 { |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2110 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
|
2111 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2112 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2113 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
|
2114 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2115 } |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2116 char_table = temp; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2117 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
|
2118 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
|
2119 = make_sub_char_table (temp)); |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2120 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
|
2121 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
|
2122 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2123 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2124 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
|
2125 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2126 } |
21339
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2127 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2128 /* Look up the element in TABLE at index CH, |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2129 and return it as an integer. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2130 If the element is nil, return CH itself. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2131 (Actually we do that for any non-integer.) */ |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2132 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2133 int |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2134 char_table_translate (table, ch) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2135 Lisp_Object table; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2136 int ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2137 { |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2138 Lisp_Object value; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2139 value = Faref (table, make_number (ch)); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2140 if (! INTEGERP (value)) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2141 return ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2142 return XINT (value); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2143 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2144 |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2145 /* 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
|
2146 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
|
2147 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
|
2148 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
|
2149 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
|
2150 |
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2151 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
|
2152 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2153 void |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2154 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
|
2155 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
|
2156 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
|
2157 int depth; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2158 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2159 int i, to; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2160 |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2161 if (depth == 0) |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2162 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2163 /* 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
|
2164 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
|
2165 { |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2166 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
|
2167 if (c_function) |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2168 (*c_function) (arg, make_number (i), elt); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2169 else |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2170 call2 (function, make_number (i), elt); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2171 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2172 #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
|
2173 we should report them. */ |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2174 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
|
2175 return; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2176 #endif |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2177 to = CHAR_TABLE_ORDINARY_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2178 } |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2179 else |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2180 { |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2181 i = 32; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2182 to = SUB_CHAR_TABLE_ORDINARY_SLOTS; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2183 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2184 |
18000
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2185 for (; i < to; i++) |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2186 { |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2187 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
|
2188 |
18108
af791b0f0657
(map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents:
18035
diff
changeset
|
2189 XSETFASTINT (indices[depth], i); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2190 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2191 if (SUB_CHAR_TABLE_P (elt)) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2192 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2193 if (depth >= 3) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2194 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
|
2195 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
|
2196 } |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2197 else |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2198 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2199 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
|
2200 |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2201 if (CHARSET_DEFINED_P (charset)) |
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2202 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2203 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2204 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2205 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
|
2206 if (c_function) |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2207 (*c_function) (arg, make_number (c), elt); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2208 else |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2209 call2 (function, make_number (c), elt); |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2210 } |
20004 | 2211 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2212 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2213 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2214 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2215 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
|
2216 2, 2, 0, |
18000
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2217 "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
|
2218 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
|
2219 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
|
2220 (function, char_table) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2221 Lisp_Object function, char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2222 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2223 /* 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
|
2224 Lisp_Object indices[3]; |
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2225 |
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2226 CHECK_CHAR_TABLE (char_table, 1); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2227 |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2228 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
|
2229 return Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2230 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2231 |
211 | 2232 /* ARGSUSED */ |
2233 Lisp_Object | |
2234 nconc2 (s1, s2) | |
2235 Lisp_Object s1, s2; | |
2236 { | |
2237 #ifdef NO_ARG_ARRAY | |
2238 Lisp_Object args[2]; | |
2239 args[0] = s1; | |
2240 args[1] = s2; | |
2241 return Fnconc (2, args); | |
2242 #else | |
2243 return Fnconc (2, &s1); | |
2244 #endif /* NO_ARG_ARRAY */ | |
2245 } | |
2246 | |
2247 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0, | |
2248 "Concatenate any number of lists by altering them.\n\ | |
2249 Only the last argument is not altered, and need not be a list.") | |
2250 (nargs, args) | |
2251 int nargs; | |
2252 Lisp_Object *args; | |
2253 { | |
2254 register int argnum; | |
2255 register Lisp_Object tail, tem, val; | |
2256 | |
2257 val = Qnil; | |
2258 | |
2259 for (argnum = 0; argnum < nargs; argnum++) | |
2260 { | |
2261 tem = args[argnum]; | |
485 | 2262 if (NILP (tem)) continue; |
211 | 2263 |
485 | 2264 if (NILP (val)) |
211 | 2265 val = tem; |
2266 | |
2267 if (argnum + 1 == nargs) break; | |
2268 | |
2269 if (!CONSP (tem)) | |
2270 tem = wrong_type_argument (Qlistp, tem); | |
2271 | |
2272 while (CONSP (tem)) | |
2273 { | |
2274 tail = tem; | |
2275 tem = Fcdr (tail); | |
2276 QUIT; | |
2277 } | |
2278 | |
2279 tem = args[argnum + 1]; | |
2280 Fsetcdr (tail, tem); | |
485 | 2281 if (NILP (tem)) |
211 | 2282 args[argnum + 1] = tail; |
2283 } | |
2284 | |
2285 return val; | |
2286 } | |
2287 | |
2288 /* 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
|
2289 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
|
2290 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
|
2291 LENI is the length of VALS, which should also be the length of SEQ. */ |
211 | 2292 |
2293 static void | |
2294 mapcar1 (leni, vals, fn, seq) | |
2295 int leni; | |
2296 Lisp_Object *vals; | |
2297 Lisp_Object fn, seq; | |
2298 { | |
2299 register Lisp_Object tail; | |
2300 Lisp_Object dummy; | |
2301 register int i; | |
2302 struct gcpro gcpro1, gcpro2, gcpro3; | |
2303 | |
2304 /* Don't let vals contain any garbage when GC happens. */ | |
2305 for (i = 0; i < leni; i++) | |
2306 vals[i] = Qnil; | |
2307 | |
2308 GCPRO3 (dummy, fn, seq); | |
2309 gcpro1.var = vals; | |
2310 gcpro1.nvars = leni; | |
2311 /* We need not explicitly protect `tail' because it is used only on lists, and | |
2312 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ | |
2313 | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2314 if (VECTORP (seq)) |
211 | 2315 { |
2316 for (i = 0; i < leni; i++) | |
2317 { | |
2318 dummy = XVECTOR (seq)->contents[i]; | |
2319 vals[i] = call1 (fn, dummy); | |
2320 } | |
2321 } | |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2322 else if (BOOL_VECTOR_P (seq)) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2323 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2324 for (i = 0; i < leni; i++) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2325 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2326 int byte; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2327 byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR]; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2328 if (byte & (1 << (i % BITS_PER_CHAR))) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2329 dummy = Qt; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2330 else |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2331 dummy = Qnil; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2332 |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2333 vals[i] = call1 (fn, dummy); |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2334 } |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2335 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2336 else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq)) |
211 | 2337 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2338 /* Single-byte string. */ |
211 | 2339 for (i = 0; i < leni; i++) |
2340 { | |
9308
2c594629baaa
(Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9289
diff
changeset
|
2341 XSETFASTINT (dummy, XSTRING (seq)->data[i]); |
211 | 2342 vals[i] = call1 (fn, dummy); |
2343 } | |
2344 } | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2345 else if (STRINGP (seq)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2346 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2347 /* Multi-byte string. */ |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21218
diff
changeset
|
2348 int len_byte = STRING_BYTES (XSTRING (seq)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2349 int i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2350 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2351 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
|
2352 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2353 int c; |
20712
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2354 int i_before = i; |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2355 |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2356 FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2357 XSETFASTINT (dummy, c); |
20712
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2358 vals[i_before] = call1 (fn, dummy); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2359 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2360 } |
211 | 2361 else /* Must be a list, since Flength did not get an error */ |
2362 { | |
2363 tail = seq; | |
2364 for (i = 0; i < leni; i++) | |
2365 { | |
2366 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
|
2367 tail = XCONS (tail)->cdr; |
211 | 2368 } |
2369 } | |
2370 | |
2371 UNGCPRO; | |
2372 } | |
2373 | |
2374 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
|
2375 "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
|
2376 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\ |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2377 SEPARATOR results in spaces between the values returned by FUNCTION.\n\ |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2378 SEQUENCE may be a list, a vector, a bool-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
|
2379 (function, sequence, separator) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2380 Lisp_Object function, sequence, separator; |
211 | 2381 { |
2382 Lisp_Object len; | |
2383 register int leni; | |
2384 int nargs; | |
2385 register Lisp_Object *args; | |
2386 register int i; | |
2387 struct gcpro gcpro1; | |
2388 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2389 len = Flength (sequence); |
211 | 2390 leni = XINT (len); |
2391 nargs = leni + leni - 1; | |
2392 if (nargs < 0) return build_string (""); | |
2393 | |
2394 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); | |
2395 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2396 GCPRO1 (separator); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2397 mapcar1 (leni, args, function, sequence); |
211 | 2398 UNGCPRO; |
2399 | |
2400 for (i = leni - 1; i >= 0; i--) | |
2401 args[i + i] = args[i]; | |
20004 | 2402 |
211 | 2403 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
|
2404 args[i] = separator; |
211 | 2405 |
2406 return Fconcat (nargs, args); | |
2407 } | |
2408 | |
2409 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0, | |
2410 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\ | |
2411 The result is a list just as long as SEQUENCE.\n\ | |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2412 SEQUENCE may be a list, a vector, a bool-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
|
2413 (function, sequence) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2414 Lisp_Object function, sequence; |
211 | 2415 { |
2416 register Lisp_Object len; | |
2417 register int leni; | |
2418 register Lisp_Object *args; | |
2419 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2420 len = Flength (sequence); |
211 | 2421 leni = XFASTINT (len); |
2422 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object)); | |
2423 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2424 mapcar1 (leni, args, function, sequence); |
211 | 2425 |
2426 return Flist (leni, args); | |
2427 } | |
2428 | |
2429 /* Anything that calls this function must protect from GC! */ | |
2430 | |
2431 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, | |
2432 "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
|
2433 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
|
2434 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\ |
211 | 2435 No confirmation of the answer is requested; a single character is enough.\n\ |
25071 | 2436 Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses\n\ |
2437 the bindings in query-replace-map; see the documentation of that variable\n\ | |
2438 for more information. In this case, the useful bindings are `act', `skip',\n\ | |
2439 `recenter', and `quit'.\)\n\ | |
24280
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2440 \n\ |
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2441 Under a windowing system a dialog box will be used if `last-nonmenu-event'\n\ |
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2442 is nil.") |
211 | 2443 (prompt) |
2444 Lisp_Object prompt; | |
2445 { | |
25071 | 2446 register Lisp_Object obj, key, def, map; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2447 register int answer; |
211 | 2448 Lisp_Object xprompt; |
2449 Lisp_Object args[2]; | |
2450 struct gcpro gcpro1, gcpro2; | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2451 int count = specpdl_ptr - specpdl; |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2452 |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2453 specbind (Qcursor_in_echo_area, Qt); |
211 | 2454 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2455 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
|
2456 |
211 | 2457 CHECK_STRING (prompt, 0); |
2458 xprompt = prompt; | |
2459 GCPRO2 (prompt, xprompt); | |
2460 | |
2461 while (1) | |
2462 { | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2463 |
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
|
2464 #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
|
2465 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
|
2466 && 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
|
2467 && 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
|
2468 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2469 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
|
2470 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
|
2471 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
|
2472 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
|
2473 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
|
2474 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
|
2475 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
|
2476 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
|
2477 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
|
2478 } |
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
|
2479 #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
|
2480 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
|
2481 choose_minibuf_frame (); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2482 message_with_string ("%s(y or n) ", xprompt, 0); |
211 | 2483 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2484 if (minibuffer_auto_raise) |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2485 { |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2486 Lisp_Object mini_frame; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2487 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2488 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2489 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2490 Fraise_frame (mini_frame); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2491 } |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2492 |
23057
2dbf1ec20bf7
(Fy_or_n_p): Don't bind input-method-function.
Richard M. Stallman <rms@gnu.org>
parents:
23051
diff
changeset
|
2493 obj = read_filtered_event (1, 0, 0, 0); |
6850
d2d8b40fb599
(Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents:
6478
diff
changeset
|
2494 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
|
2495 /* 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
|
2496 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
|
2497 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2498 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
|
2499 def = Flookup_key (map, key, Qt); |
211 | 2500 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2501 if (EQ (def, intern ("skip"))) |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2502 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2503 answer = 0; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2504 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2505 } |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2506 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
|
2507 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2508 answer = 1; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2509 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2510 } |
2311
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2511 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
|
2512 { |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2513 Frecenter (Qnil); |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2514 xprompt = prompt; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2515 continue; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2516 } |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2517 else if (EQ (def, intern ("quit"))) |
211 | 2518 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
|
2519 /* 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
|
2520 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
|
2521 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
|
2522 Vquit_flag = Qt; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2523 |
211 | 2524 QUIT; |
1194 | 2525 |
2526 /* If we don't clear this, then the next call to read_char will | |
2527 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
|
2528 Vquit_flag = Qnil; |
211 | 2529 |
2530 Fding (Qnil); | |
2531 Fdiscard_input (); | |
2532 if (EQ (xprompt, prompt)) | |
2533 { | |
2534 args[0] = build_string ("Please answer y or n. "); | |
2535 args[1] = prompt; | |
2536 xprompt = Fconcat (2, args); | |
2537 } | |
2538 } | |
2539 UNGCPRO; | |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2540 |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2541 if (! noninteractive) |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2542 { |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2543 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
|
2544 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
|
2545 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
|
2546 } |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2547 |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2548 unbind_to (count, Qnil); |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2549 return answer ? Qt : Qnil; |
211 | 2550 } |
2551 | |
2552 /* This is how C code calls `yes-or-no-p' and allows the user | |
2553 to redefined it. | |
2554 | |
2555 Anything that calls this function must protect from GC! */ | |
2556 | |
2557 Lisp_Object | |
2558 do_yes_or_no_p (prompt) | |
2559 Lisp_Object prompt; | |
2560 { | |
2561 return call1 (intern ("yes-or-no-p"), prompt); | |
2562 } | |
2563 | |
2564 /* Anything that calls this function must protect from GC! */ | |
2565 | |
2566 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
|
2567 "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
|
2568 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
|
2569 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
|
2570 The user must confirm the answer with RET,\n\ |
24280
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2571 and can edit it until it has been confirmed.\n\ |
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2572 \n\ |
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2573 Under a windowing system a dialog box will be used if `last-nonmenu-event'\n\ |
40703a998d73
(Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents:
24275
diff
changeset
|
2574 is nil.") |
211 | 2575 (prompt) |
2576 Lisp_Object prompt; | |
2577 { | |
2578 register Lisp_Object ans; | |
2579 Lisp_Object args[2]; | |
2580 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
|
2581 Lisp_Object menu; |
211 | 2582 |
2583 CHECK_STRING (prompt, 0); | |
2584 | |
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
|
2585 #ifdef HAVE_MENUS |
20004 | 2586 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
|
2587 && 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
|
2588 && 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
|
2589 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2590 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
|
2591 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
|
2592 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
|
2593 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
|
2594 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
|
2595 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
|
2596 menu = Fcons (prompt, pane); |
6344 | 2597 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
|
2598 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
|
2599 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
|
2600 } |
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
|
2601 #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
|
2602 |
211 | 2603 args[0] = prompt; |
2604 args[1] = build_string ("(yes or no) "); | |
2605 prompt = Fconcat (2, args); | |
2606 | |
2607 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
|
2608 |
211 | 2609 while (1) |
2610 { | |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
2611 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
|
2612 Qyes_or_no_p_history, Qnil, |
6d3cc8864678
(Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents:
19383
diff
changeset
|
2613 Qnil)); |
211 | 2614 if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes")) |
2615 { | |
2616 UNGCPRO; | |
2617 return Qt; | |
2618 } | |
2619 if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no")) | |
2620 { | |
2621 UNGCPRO; | |
2622 return Qnil; | |
2623 } | |
2624 | |
2625 Fding (Qnil); | |
2626 Fdiscard_input (); | |
2627 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
|
2628 Fsleep_for (make_number (2), Qnil); |
211 | 2629 } |
2630 } | |
2631 | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2632 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0, |
211 | 2633 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\ |
2634 Each of the three load averages is multiplied by 100,\n\ | |
727 | 2635 then converted to integer.\n\ |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2636 When USE-FLOATS is non-nil, floats will be used instead of integers.\n\ |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2637 These floats are not multiplied by 100.\n\n\ |
727 | 2638 If the 5-minute or 15-minute load averages are not available, return a\n\ |
2639 shortened list, containing only those averages which are available.") | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2640 (use_floats) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2641 Lisp_Object use_floats; |
211 | 2642 { |
727 | 2643 double load_ave[3]; |
2644 int loads = getloadavg (load_ave, 3); | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2645 Lisp_Object ret = Qnil; |
211 | 2646 |
727 | 2647 if (loads < 0) |
2648 error ("load-average not implemented for this operating system"); | |
211 | 2649 |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2650 while (loads-- > 0) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2651 { |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2652 Lisp_Object load = (NILP (use_floats) ? |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2653 make_number ((int) (100.0 * load_ave[loads])) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2654 : make_float (load_ave[loads])); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2655 ret = Fcons (load, ret); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2656 } |
211 | 2657 |
727 | 2658 return ret; |
211 | 2659 } |
2660 | |
2661 Lisp_Object Vfeatures; | |
2662 | |
2663 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0, | |
2664 "Returns t if FEATURE is present in this Emacs.\n\ | |
2665 Use this to conditionalize execution of lisp code based on the presence or\n\ | |
2666 absence of emacs or environment extensions.\n\ | |
2667 Use `provide' to declare that a feature is available.\n\ | |
2668 This function looks at the value of the variable `features'.") | |
20004 | 2669 (feature) |
211 | 2670 Lisp_Object feature; |
2671 { | |
2672 register Lisp_Object tem; | |
2673 CHECK_SYMBOL (feature, 0); | |
2674 tem = Fmemq (feature, Vfeatures); | |
485 | 2675 return (NILP (tem)) ? Qnil : Qt; |
211 | 2676 } |
2677 | |
2678 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0, | |
2679 "Announce that FEATURE is a feature of the current Emacs.") | |
20004 | 2680 (feature) |
211 | 2681 Lisp_Object feature; |
2682 { | |
2683 register Lisp_Object tem; | |
2684 CHECK_SYMBOL (feature, 0); | |
485 | 2685 if (!NILP (Vautoload_queue)) |
211 | 2686 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); |
2687 tem = Fmemq (feature, Vfeatures); | |
485 | 2688 if (NILP (tem)) |
211 | 2689 Vfeatures = Fcons (feature, Vfeatures); |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2690 LOADHIST_ATTACH (Fcons (Qprovide, feature)); |
211 | 2691 return feature; |
2692 } | |
2693 | |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2694 DEFUN ("require", Frequire, Srequire, 1, 3, 0, |
211 | 2695 "If feature FEATURE is not loaded, load it from FILENAME.\n\ |
2696 If FEATURE is not a member of the list `features', then the feature\n\ | |
2697 is not loaded; so load the file FILENAME.\n\ | |
21577 | 2698 If FILENAME is omitted, the printname of FEATURE is used as the file name,\n\ |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2699 but in this case `load' insists on adding the suffix `.el' or `.elc'.\n\ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2700 If the optional third argument NOERROR is non-nil,\n\ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2701 then return nil if the file is not found.\n\ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2702 Normally the return value is FEATURE.") |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2703 (feature, file_name, noerror) |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2704 Lisp_Object feature, file_name, noerror; |
211 | 2705 { |
2706 register Lisp_Object tem; | |
2707 CHECK_SYMBOL (feature, 0); | |
2708 tem = Fmemq (feature, Vfeatures); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2709 LOADHIST_ATTACH (Fcons (Qrequire, feature)); |
485 | 2710 if (NILP (tem)) |
211 | 2711 { |
2712 int count = specpdl_ptr - specpdl; | |
2713 | |
2714 /* Value saved here is to be restored into Vautoload_queue */ | |
2715 record_unwind_protect (un_autoload, Vautoload_queue); | |
2716 Vautoload_queue = Qt; | |
2717 | |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2718 tem = Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name, |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2719 noerror, Qt, Qnil, (NILP (file_name) ? Qt : Qnil)); |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2720 /* If load failed entirely, return nil. */ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2721 if (NILP (tem)) |
24016
43344f47a865
(Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents:
23927
diff
changeset
|
2722 return unbind_to (count, Qnil); |
211 | 2723 |
2724 tem = Fmemq (feature, Vfeatures); | |
485 | 2725 if (NILP (tem)) |
211 | 2726 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
|
2727 XSYMBOL (feature)->name->data); |
211 | 2728 |
2729 /* Once loading finishes, don't undo it. */ | |
2730 Vautoload_queue = Qt; | |
2731 feature = unbind_to (count, feature); | |
2732 } | |
2733 return feature; | |
2734 } | |
2735 | |
20004 | 2736 /* Primitives for work of the "widget" library. |
2737 In an ideal world, this section would not have been necessary. | |
2738 However, lisp function calls being as slow as they are, it turns | |
2739 out that some functions in the widget library (wid-edit.el) are the | |
2740 bottleneck of Widget operation. Here is their translation to C, | |
2741 for the sole reason of efficiency. */ | |
2742 | |
2743 DEFUN ("widget-plist-member", Fwidget_plist_member, Swidget_plist_member, 2, 2, 0, | |
2744 "Return non-nil if PLIST has the property PROP.\n\ | |
2745 PLIST is a property list, which is a list of the form\n\ | |
2746 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\ | |
2747 Unlike `plist-get', this allows you to distinguish between a missing\n\ | |
2748 property and a property with the value nil.\n\ | |
2749 The value is actually the tail of PLIST whose car is PROP.") | |
2750 (plist, prop) | |
2751 Lisp_Object plist, prop; | |
2752 { | |
2753 while (CONSP (plist) && !EQ (XCAR (plist), prop)) | |
2754 { | |
2755 QUIT; | |
2756 plist = XCDR (plist); | |
2757 plist = CDR (plist); | |
2758 } | |
2759 return plist; | |
2760 } | |
2761 | |
2762 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, | |
2763 "In WIDGET, set PROPERTY to VALUE.\n\ | |
2764 The value can later be retrieved with `widget-get'.") | |
2765 (widget, property, value) | |
2766 Lisp_Object widget, property, value; | |
2767 { | |
2768 CHECK_CONS (widget, 1); | |
2769 XCDR (widget) = Fplist_put (XCDR (widget), property, value); | |
23207
302eccdcb73c
(Fwidget_put): Return VALUE instead of garbage.
Karl Heuer <kwzh@gnu.org>
parents:
23152
diff
changeset
|
2770 return value; |
20004 | 2771 } |
2772 | |
2773 DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0, | |
2774 "In WIDGET, get the value of PROPERTY.\n\ | |
2775 The value could either be specified when the widget was created, or\n\ | |
2776 later with `widget-put'.") | |
2777 (widget, property) | |
2778 Lisp_Object widget, property; | |
2779 { | |
2780 Lisp_Object tmp; | |
2781 | |
2782 while (1) | |
2783 { | |
2784 if (NILP (widget)) | |
2785 return Qnil; | |
2786 CHECK_CONS (widget, 1); | |
2787 tmp = Fwidget_plist_member (XCDR (widget), property); | |
2788 if (CONSP (tmp)) | |
2789 { | |
2790 tmp = XCDR (tmp); | |
2791 return CAR (tmp); | |
2792 } | |
2793 tmp = XCAR (widget); | |
2794 if (NILP (tmp)) | |
2795 return Qnil; | |
2796 widget = Fget (tmp, Qwidget_type); | |
2797 } | |
2798 } | |
2799 | |
2800 DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0, | |
2801 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\ | |
2802 ARGS are passed as extra arguments to the function.") | |
2803 (nargs, args) | |
2804 int nargs; | |
2805 Lisp_Object *args; | |
2806 { | |
2807 /* This function can GC. */ | |
2808 Lisp_Object newargs[3]; | |
2809 struct gcpro gcpro1, gcpro2; | |
2810 Lisp_Object result; | |
2811 | |
2812 newargs[0] = Fwidget_get (args[0], args[1]); | |
2813 newargs[1] = args[0]; | |
2814 newargs[2] = Flist (nargs - 2, args + 2); | |
2815 GCPRO2 (newargs[0], newargs[2]); | |
2816 result = Fapply (3, newargs); | |
2817 UNGCPRO; | |
2818 return result; | |
2819 } | |
2820 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2821 /* base64 encode/decode functions. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2822 Based on code from GNU recode. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2823 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2824 #define MIME_LINE_LENGTH 76 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2825 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2826 #define IS_ASCII(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2827 ((Character) < 128) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2828 #define IS_BASE64(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2829 (IS_ASCII (Character) && base64_char_to_value[Character] >= 0) |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2830 #define IS_BASE64_IGNORABLE(Character) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2831 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2832 || (Character) == '\f' || (Character) == '\r') |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2833 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2834 /* Used by base64_decode_1 to retrieve a non-base64-ignorable |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2835 character or return retval if there are no characters left to |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2836 process. */ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2837 #define READ_QUADRUPLET_BYTE(retval) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2838 do \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2839 { \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2840 if (i == length) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2841 return (retval); \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2842 c = from[i++]; \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2843 } \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
2844 while (IS_BASE64_IGNORABLE (c)) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2845 |
23690 | 2846 /* Don't use alloca for regions larger than this, lest we overflow |
2847 their stack. */ | |
2848 #define MAX_ALLOCA 16*1024 | |
2849 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2850 /* Table of characters coding the 64 values. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2851 static char base64_value_to_char[64] = |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2852 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2853 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2854 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2855 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', /* 20-29 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2856 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', /* 30-39 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2857 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', /* 40-49 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2858 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', /* 50-59 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2859 '8', '9', '+', '/' /* 60-63 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2860 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2861 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2862 /* Table of base64 values for first 128 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2863 static short base64_char_to_value[128] = |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2864 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2865 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2866 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2867 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2868 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2869 -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2870 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2871 -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2872 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2873 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2874 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2875 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2876 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2877 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2878 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2879 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2880 /* The following diagram shows the logical steps by which three octets |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2881 get transformed into four base64 characters. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2882 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2883 .--------. .--------. .--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2884 |aaaaaabb| |bbbbcccc| |ccdddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2885 `--------' `--------' `--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2886 6 2 4 4 2 6 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2887 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2888 |00aaaaaa|00bbbbbb|00cccccc|00dddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2889 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2890 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2891 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2892 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2893 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2894 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2895 The octets are divided into 6 bit chunks, which are then encoded into |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2896 base64 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2897 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2898 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2899 static int base64_encode_1 P_ ((const char *, char *, int, int)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2900 static int base64_decode_1 P_ ((const char *, char *, int)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2901 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2902 DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region, |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2903 2, 3, "r", |
23557
1a67e5327a04
(Fbase64_decode_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
23556
diff
changeset
|
2904 "Base64-encode the region between BEG and END.\n\ |
23556
82fdd7048bcf
(Fbase64_decode_region, Fbase64_encode_region): Fix
Dave Love <fx@gnu.org>
parents:
23536
diff
changeset
|
2905 Return the length of the encoded text.\n\ |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2906 Optional third argument NO-LINE-BREAK means do not break long lines\n\ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2907 into shorter lines.") |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2908 (beg, end, no_line_break) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2909 Lisp_Object beg, end, no_line_break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2910 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2911 char *encoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2912 int allength, length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2913 int ibeg, iend, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2914 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2915 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2916 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2917 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2918 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2919 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2920 move_gap_both (XFASTINT (beg), ibeg); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2921 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2922 /* We need to allocate enough room for encoding the text. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2923 We need 33 1/3% more space, plus a newline every 76 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2924 characters, and then we round up. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2925 length = iend - ibeg; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2926 allength = length + length/3 + 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2927 allength += allength / MIME_LINE_LENGTH + 1 + 6; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2928 |
23690 | 2929 if (allength <= MAX_ALLOCA) |
2930 encoded = (char *) alloca (allength); | |
2931 else | |
2932 encoded = (char *) xmalloc (allength); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2933 encoded_length = base64_encode_1 (BYTE_POS_ADDR (ibeg), encoded, length, |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2934 NILP (no_line_break)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2935 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2936 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2937 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2938 /* Now we have encoded the region, so we insert the new contents |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2939 and delete the old. (Insert first in order to preserve markers.) */ |
23579
3d1bb0100afb
(Fbase64_encode_region): Use SET_PT_BOTH instead of SET_PT
Andreas Schwab <schwab@suse.de>
parents:
23557
diff
changeset
|
2940 SET_PT_BOTH (XFASTINT (beg), ibeg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2941 insert (encoded, encoded_length); |
23690 | 2942 if (allength > MAX_ALLOCA) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
2943 xfree (encoded); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2944 del_range_byte (ibeg + encoded_length, iend + encoded_length, 1); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2945 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2946 /* If point was outside of the region, restore it exactly; else just |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2947 move to the beginning of the region. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2948 if (old_pos >= XFASTINT (end)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2949 old_pos += encoded_length - (XFASTINT (end) - XFASTINT (beg)); |
23579
3d1bb0100afb
(Fbase64_encode_region): Use SET_PT_BOTH instead of SET_PT
Andreas Schwab <schwab@suse.de>
parents:
23557
diff
changeset
|
2950 else if (old_pos > XFASTINT (beg)) |
3d1bb0100afb
(Fbase64_encode_region): Use SET_PT_BOTH instead of SET_PT
Andreas Schwab <schwab@suse.de>
parents:
23557
diff
changeset
|
2951 old_pos = XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2952 SET_PT (old_pos); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2953 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2954 /* We return the length of the encoded text. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2955 return make_number (encoded_length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2956 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2957 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2958 DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string, |
24334
c56b72e5f29d
(Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents:
24280
diff
changeset
|
2959 1, 2, 0, |
c56b72e5f29d
(Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents:
24280
diff
changeset
|
2960 "Base64-encode STRING and return the result.\n\ |
c56b72e5f29d
(Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents:
24280
diff
changeset
|
2961 Optional second argument NO-LINE-BREAK means do not break long lines\n\ |
c56b72e5f29d
(Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents:
24280
diff
changeset
|
2962 into shorter lines.") |
c56b72e5f29d
(Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents:
24280
diff
changeset
|
2963 (string, no_line_break) |
24377
f881dd22ec7d
(Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents:
24334
diff
changeset
|
2964 Lisp_Object string, no_line_break; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2965 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2966 int allength, length, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2967 char *encoded; |
23690 | 2968 Lisp_Object encoded_string; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2969 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2970 CHECK_STRING (string, 1); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2971 |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
2972 /* We need to allocate enough room for encoding the text. |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
2973 We need 33 1/3% more space, plus a newline every 76 |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
2974 characters, and then we round up. */ |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2975 length = STRING_BYTES (XSTRING (string)); |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
2976 allength = length + length/3 + 1; |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
2977 allength += allength / MIME_LINE_LENGTH + 1 + 6; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2978 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2979 /* We need to allocate enough room for decoding the text. */ |
23690 | 2980 if (allength <= MAX_ALLOCA) |
2981 encoded = (char *) alloca (allength); | |
2982 else | |
2983 encoded = (char *) xmalloc (allength); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2984 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2985 encoded_length = base64_encode_1 (XSTRING (string)->data, |
24334
c56b72e5f29d
(Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents:
24280
diff
changeset
|
2986 encoded, length, NILP (no_line_break)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2987 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2988 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2989 |
23690 | 2990 encoded_string = make_unibyte_string (encoded, encoded_length); |
2991 if (allength > MAX_ALLOCA) | |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
2992 xfree (encoded); |
23690 | 2993 |
2994 return encoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2995 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2996 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2997 static int |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2998 base64_encode_1 (from, to, length, line_break) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
2999 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3000 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3001 int length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3002 int line_break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3003 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3004 int counter = 0, i = 0; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3005 char *e = to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3006 unsigned char c; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3007 unsigned int value; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3008 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3009 while (i < length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3010 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3011 c = from[i++]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3012 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3013 /* Wrap line every 76 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3014 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3015 if (line_break) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3016 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3017 if (counter < MIME_LINE_LENGTH / 4) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3018 counter++; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3019 else |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3020 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3021 *e++ = '\n'; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3022 counter = 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3023 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3024 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3025 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3026 /* Process first byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3027 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3028 *e++ = base64_value_to_char[0x3f & c >> 2]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3029 value = (0x03 & c) << 4; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3030 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3031 /* Process second byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3032 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3033 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3034 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3035 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3036 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3037 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3038 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3039 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3040 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3041 c = from[i++]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3042 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3043 *e++ = base64_value_to_char[value | (0x0f & c >> 4)]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3044 value = (0x0f & c) << 2; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3045 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3046 /* Process third byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3047 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3048 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3049 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3050 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3051 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3052 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3053 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3054 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3055 c = from[i++]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3056 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3057 *e++ = base64_value_to_char[value | (0x03 & c >> 6)]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3058 *e++ = base64_value_to_char[0x3f & c]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3059 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3060 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3061 return e - to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3062 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3063 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3064 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3065 DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region, |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3066 2, 2, "r", |
23557
1a67e5327a04
(Fbase64_decode_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
23556
diff
changeset
|
3067 "Base64-decode the region between BEG and END.\n\ |
23556
82fdd7048bcf
(Fbase64_decode_region, Fbase64_encode_region): Fix
Dave Love <fx@gnu.org>
parents:
23536
diff
changeset
|
3068 Return the length of the decoded text.\n\ |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3069 If the region can't be decoded, return nil and don't modify the buffer.") |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3070 (beg, end) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3071 Lisp_Object beg, end; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3072 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3073 int ibeg, iend, length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3074 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3075 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3076 int decoded_length; |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3077 int inserted_chars; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3078 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3079 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3080 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3081 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3082 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3083 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3084 length = iend - ibeg; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3085 /* We need to allocate enough room for decoding the text. */ |
23690 | 3086 if (length <= MAX_ALLOCA) |
3087 decoded = (char *) alloca (length); | |
3088 else | |
3089 decoded = (char *) xmalloc (length); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3090 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3091 move_gap_both (XFASTINT (beg), ibeg); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3092 decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3093 if (decoded_length > length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3094 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3095 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3096 if (decoded_length < 0) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3097 { |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3098 /* The decoding wasn't possible. */ |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3099 if (length > MAX_ALLOCA) |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3100 xfree (decoded); |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3101 return Qnil; |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3102 } |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3103 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3104 /* Now we have decoded the region, so we insert the new contents |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3105 and delete the old. (Insert first in order to preserve markers.) */ |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3106 /* We insert two spaces, then insert the decoded text in between |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3107 them, at last, delete those extra two spaces. This is to avoid |
23595
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3108 byte combining while inserting. */ |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3109 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3110 insert_1_both (" ", 2, 2, 0, 1, 0); |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3111 TEMP_SET_PT_BOTH (XFASTINT (beg) + 1, ibeg + 1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3112 insert (decoded, decoded_length); |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3113 inserted_chars = PT - (XFASTINT (beg) + 1); |
23690 | 3114 if (length > MAX_ALLOCA) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3115 xfree (decoded); |
23595
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3116 /* At first delete the original text. This never cause byte |
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3117 combining. */ |
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3118 del_range_both (PT + 1, PT_BYTE + 1, XFASTINT (end) + inserted_chars + 2, |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3119 iend + decoded_length + 2, 1); |
23595
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3120 /* Next delete the extra spaces. This will cause byte combining |
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3121 error. */ |
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3122 del_range_both (PT, PT_BYTE, PT + 1, PT_BYTE + 1, 0); |
e8bf0c9f869d
(Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23579
diff
changeset
|
3123 del_range_both (XFASTINT (beg), ibeg, XFASTINT (beg) + 1, ibeg + 1, 0); |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3124 inserted_chars = PT - XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3125 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3126 /* If point was outside of the region, restore it exactly; else just |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3127 move to the beginning of the region. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3128 if (old_pos >= XFASTINT (end)) |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3129 old_pos += inserted_chars - (XFASTINT (end) - XFASTINT (beg)); |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3130 else if (old_pos > XFASTINT (beg)) |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3131 old_pos = XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3132 SET_PT (old_pos); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3133 |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3134 return make_number (inserted_chars); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3135 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3136 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3137 DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3138 1, 1, 0, |
23557
1a67e5327a04
(Fbase64_decode_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
23556
diff
changeset
|
3139 "Base64-decode STRING and return the result.") |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3140 (string) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3141 Lisp_Object string; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3142 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3143 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3144 int length, decoded_length; |
23690 | 3145 Lisp_Object decoded_string; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3146 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3147 CHECK_STRING (string, 1); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3148 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3149 length = STRING_BYTES (XSTRING (string)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3150 /* We need to allocate enough room for decoding the text. */ |
23690 | 3151 if (length <= MAX_ALLOCA) |
3152 decoded = (char *) alloca (length); | |
3153 else | |
3154 decoded = (char *) xmalloc (length); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3155 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3156 decoded_length = base64_decode_1 (XSTRING (string)->data, decoded, length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3157 if (decoded_length > length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3158 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3159 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3160 if (decoded_length < 0) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3161 /* The decoding wasn't possible. */ |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3162 decoded_string = Qnil; |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3163 else |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3164 decoded_string = make_string (decoded, decoded_length); |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3165 |
23690 | 3166 if (length > MAX_ALLOCA) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3167 xfree (decoded); |
23690 | 3168 |
3169 return decoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3170 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3171 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3172 static int |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3173 base64_decode_1 (from, to, length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3174 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3175 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3176 int length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3177 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3178 int i = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3179 char *e = to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3180 unsigned char c; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3181 unsigned long value; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3182 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3183 while (1) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3184 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3185 /* Process first byte of a quadruplet. */ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3186 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3187 READ_QUADRUPLET_BYTE (e-to); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3188 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3189 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3190 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3191 value = base64_char_to_value[c] << 18; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3192 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3193 /* Process second byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3194 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3195 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3196 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3197 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3198 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3199 value |= base64_char_to_value[c] << 12; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3200 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3201 *e++ = (unsigned char) (value >> 16); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3202 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3203 /* Process third byte of a quadruplet. */ |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3204 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3205 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3206 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3207 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3208 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3209 READ_QUADRUPLET_BYTE (-1); |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3210 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3211 if (c != '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3212 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3213 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3214 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3215 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3216 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3217 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3218 value |= base64_char_to_value[c] << 6; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3219 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3220 *e++ = (unsigned char) (0xff & value >> 8); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3221 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3222 /* Process fourth byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3223 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3224 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3225 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3226 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3227 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3228 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3229 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3230 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3231 value |= base64_char_to_value[c]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3232 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3233 *e++ = (unsigned char) (0xff & value); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3234 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3235 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3236 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3237 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3238 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3239 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3240 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3241 ***** Hash Tables ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3242 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3243 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3244 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3245 /* Implemented by gerd@gnu.org. This hash table implementation was |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3246 inspired by CMUCL hash tables. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3247 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3248 /* Ideas: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3249 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3250 1. For small tables, association lists are probably faster than |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3251 hash tables because they have lower overhead. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3252 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3253 For uses of hash tables where the O(1) behavior of table |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3254 operations is not a requirement, it might therefore be a good idea |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3255 not to hash. Instead, we could just do a linear search in the |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3256 key_and_value vector of the hash table. This could be done |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3257 if a `:linear-search t' argument is given to make-hash-table. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3258 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3259 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3260 /* Return the contents of vector V at index IDX. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3261 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3262 #define AREF(V, IDX) XVECTOR (V)->contents[IDX] |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3263 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3264 /* Value is the key part of entry IDX in hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3265 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3266 #define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3267 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3268 /* Value is the value part of entry IDX in hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3269 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3270 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3271 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3272 /* Value is the index of the next entry following the one at IDX |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3273 in hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3274 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3275 #define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3276 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3277 /* Value is the hash code computed for entry IDX in hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3278 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3279 #define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3280 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3281 /* Value is the index of the element in hash table H that is the |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3282 start of the collision list at index IDX in the index vector of H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3283 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3284 #define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3285 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3286 /* Value is the size of hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3287 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3288 #define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3289 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3290 /* The list of all weak hash tables. Don't staticpro this one. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3291 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3292 Lisp_Object Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3293 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3294 /* Various symbols. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3295 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3296 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey_weak, Qvalue_weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3297 Lisp_Object Qkey_value_weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3298 Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3299 Lisp_Object Qhash_table_test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3300 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3301 /* Function prototypes. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3302 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3303 static struct Lisp_Hash_Table *check_hash_table P_ ((Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3304 static int next_almost_prime P_ ((int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3305 static int get_key_arg P_ ((Lisp_Object, int, Lisp_Object *, char *)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3306 static Lisp_Object larger_vector P_ ((Lisp_Object, int, Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3307 static void maybe_resize_hash_table P_ ((struct Lisp_Hash_Table *)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3308 static int cmpfn_eq P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3309 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3310 static int cmpfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3311 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3312 static int cmpfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3313 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3314 static int cmpfn_user_defined P_ ((struct Lisp_Hash_Table *, Lisp_Object, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3315 unsigned, Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3316 static unsigned hashfn_eq P_ ((struct Lisp_Hash_Table *, Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3317 static unsigned hashfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3318 static unsigned hashfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3319 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3320 Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3321 static unsigned sxhash_string P_ ((unsigned char *, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3322 static unsigned sxhash_list P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3323 static unsigned sxhash_vector P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3324 static unsigned sxhash_bool_vector P_ ((Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3325 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3326 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3327 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3328 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3329 Utilities |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3330 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3331 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3332 /* If OBJ is a Lisp hash table, return a pointer to its struct |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3333 Lisp_Hash_Table. Otherwise, signal an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3334 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3335 static struct Lisp_Hash_Table * |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3336 check_hash_table (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3337 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3338 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3339 CHECK_HASH_TABLE (obj, 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3340 return XHASH_TABLE (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3341 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3342 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3343 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3344 /* Value is the next integer I >= N, N >= 0 which is "almost" a prime |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3345 number. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3346 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3347 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3348 next_almost_prime (n) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3349 int n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3350 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3351 if (n % 2 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3352 n += 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3353 if (n % 3 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3354 n += 2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3355 if (n % 7 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3356 n += 4; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3357 return n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3358 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3359 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3360 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3361 /* Find KEY in ARGS which has size NARGS. Don't consider indices for |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3362 which USED[I] is non-zero. If found at index I in ARGS, set |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3363 USED[I] and USED[I + 1] to 1, and return I + 1. Otherwise return |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3364 -1. This function is used to extract a keyword/argument pair from |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3365 a DEFUN parameter list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3366 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3367 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3368 get_key_arg (key, nargs, args, used) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3369 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3370 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3371 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3372 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3373 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3374 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3375 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3376 for (i = 0; i < nargs - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3377 if (!used[i] && EQ (args[i], key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3378 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3379 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3380 if (i >= nargs - 1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3381 i = -1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3382 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3383 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3384 used[i++] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3385 used[i] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3386 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3387 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3388 return i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3389 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3390 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3391 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3392 /* Return a Lisp vector which has the same contents as VEC but has |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3393 size NEW_SIZE, NEW_SIZE >= VEC->size. Entries in the resulting |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3394 vector that are not copied from VEC are set to INIT. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3395 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3396 static Lisp_Object |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3397 larger_vector (vec, new_size, init) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3398 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3399 int new_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3400 Lisp_Object init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3401 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3402 struct Lisp_Vector *v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3403 int i, old_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3404 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3405 xassert (VECTORP (vec)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3406 old_size = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3407 xassert (new_size >= old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3408 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3409 v = allocate_vectorlike (new_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3410 v->size = new_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3411 bcopy (XVECTOR (vec)->contents, v->contents, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3412 old_size * sizeof *v->contents); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3413 for (i = old_size; i < new_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3414 v->contents[i] = init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3415 XSETVECTOR (vec, v); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3416 return vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3417 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3418 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3419 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3420 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3421 Low-level Functions |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3422 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3423 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3424 /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3425 HASH2 in hash table H using `eq'. Value is non-zero if KEY1 and |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3426 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3427 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3428 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3429 cmpfn_eq (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3430 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3431 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3432 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3433 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3434 return EQ (key1, key2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3435 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3436 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3437 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3438 /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3439 HASH2 in hash table H using `eql'. Value is non-zero if KEY1 and |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3440 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3441 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3442 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3443 cmpfn_eql (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3444 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3445 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3446 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3447 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3448 return (EQ (key1, key2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3449 || (FLOATP (key1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3450 && FLOATP (key2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3451 && XFLOAT (key1)->data == XFLOAT (key2)->data)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3452 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3453 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3454 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3455 /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3456 HASH2 in hash table H using `equal'. Value is non-zero if KEY1 and |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3457 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3458 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3459 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3460 cmpfn_equal (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3461 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3462 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3463 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3464 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3465 return (EQ (key1, key2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3466 || (hash1 == hash2 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3467 && !NILP (Fequal (key1, key2)))); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3468 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3469 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3470 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3471 /* Compare KEY1 which has hash code HASH1, and KEY2 with hash code |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3472 HASH2 in hash table H using H->user_cmp_function. Value is non-zero |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3473 if KEY1 and KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3474 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3475 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3476 cmpfn_user_defined (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3477 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3478 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3479 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3480 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3481 if (hash1 == hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3482 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3483 Lisp_Object args[3]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3484 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3485 args[0] = h->user_cmp_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3486 args[1] = key1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3487 args[2] = key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3488 return !NILP (Ffuncall (3, args)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3489 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3490 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3491 return 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3492 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3493 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3494 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3495 /* Value is a hash code for KEY for use in hash table H which uses |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3496 `eq' to compare keys. The hash code returned is guaranteed to fit |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3497 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3498 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3499 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3500 hashfn_eq (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3501 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3502 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3503 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3504 /* Lisp strings can change their address. Don't try to compute a |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3505 hash code for a string from its address. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3506 if (STRINGP (key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3507 return sxhash_string (XSTRING (key)->data, XSTRING (key)->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3508 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3509 return XUINT (key) ^ XGCTYPE (key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3510 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3511 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3512 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3513 /* Value is a hash code for KEY for use in hash table H which uses |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3514 `eql' to compare keys. The hash code returned is guaranteed to fit |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3515 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3516 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3517 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3518 hashfn_eql (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3519 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3520 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3521 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3522 /* Lisp strings can change their address. Don't try to compute a |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3523 hash code for a string from its address. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3524 if (STRINGP (key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3525 return sxhash_string (XSTRING (key)->data, XSTRING (key)->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3526 else if (FLOATP (key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3527 return sxhash (key, 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3528 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3529 return XUINT (key) ^ XGCTYPE (key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3530 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3531 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3532 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3533 /* Value is a hash code for KEY for use in hash table H which uses |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3534 `equal' to compare keys. The hash code returned is guaranteed to fit |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3535 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3536 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3537 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3538 hashfn_equal (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3539 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3540 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3541 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3542 return sxhash (key, 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3543 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3544 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3545 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3546 /* Value is a hash code for KEY for use in hash table H which uses as |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3547 user-defined function to compare keys. The hash code returned is |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3548 guaranteed to fit in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3549 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3550 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3551 hashfn_user_defined (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3552 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3553 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3554 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3555 Lisp_Object args[2], hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3556 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3557 args[0] = h->user_hash_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3558 args[1] = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3559 hash = Ffuncall (2, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3560 if (!INTEGERP (hash)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3561 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3562 list2 (build_string ("Illegal hash code returned from \ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3563 user-supplied hash function"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3564 hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3565 return XUINT (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3566 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3567 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3568 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3569 /* Create and initialize a new hash table. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3570 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3571 TEST specifies the test the hash table will use to compare keys. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3572 It must be either one of the predefined tests `eq', `eql' or |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3573 `equal' or a symbol denoting a user-defined test named TEST with |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3574 test and hash functions USER_TEST and USER_HASH. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3575 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3576 Give the table initial capacity SIZE, SIZE > 0, an integer. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3577 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3578 If REHASH_SIZE is an integer, it must be > 0, and this hash table's |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3579 new size when it becomes full is computed by adding REHASH_SIZE to |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3580 its old size. If REHASH_SIZE is a float, it must be > 1.0, and the |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3581 table's new size is computed by multiplying its old size with |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3582 REHASH_SIZE. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3583 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3584 REHASH_THRESHOLD must be a float <= 1.0, and > 0. The table will |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3585 be resized when the ratio of (number of entries in the table) / |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3586 (table size) is >= REHASH_THRESHOLD. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3587 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3588 WEAK specifies the weakness of the table. If non-nil, it must be |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3589 one of the symbols `key-weak', `value-weak' or `key-value-weak'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3590 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3591 Lisp_Object |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3592 make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3593 user_test, user_hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3594 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3595 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3596 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3597 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3598 struct Lisp_Vector *v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3599 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3600 int index_size, i, len, sz; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3601 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3602 /* Preconditions. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3603 xassert (SYMBOLP (test)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3604 xassert (INTEGERP (size) && XINT (size) > 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3605 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3606 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3607 xassert (FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3608 && XFLOATINT (rehash_threshold) > 0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3609 && XFLOATINT (rehash_threshold) <= 1.0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3610 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3611 /* Allocate a vector, and initialize it. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3612 len = VECSIZE (struct Lisp_Hash_Table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3613 v = allocate_vectorlike (len); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3614 v->size = len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3615 for (i = 0; i < len; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3616 v->contents[i] = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3617 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3618 /* Initialize hash table slots. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3619 sz = XFASTINT (size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3620 h = (struct Lisp_Hash_Table *) v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3621 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3622 h->test = test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3623 if (EQ (test, Qeql)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3624 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3625 h->cmpfn = cmpfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3626 h->hashfn = hashfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3627 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3628 else if (EQ (test, Qeq)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3629 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3630 h->cmpfn = cmpfn_eq; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3631 h->hashfn = hashfn_eq; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3632 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3633 else if (EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3634 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3635 h->cmpfn = cmpfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3636 h->hashfn = hashfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3637 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3638 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3639 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3640 h->user_cmp_function = user_test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3641 h->user_hash_function = user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3642 h->cmpfn = cmpfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3643 h->hashfn = hashfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3644 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3645 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3646 h->weak = weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3647 h->rehash_threshold = rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3648 h->rehash_size = rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3649 h->count = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3650 h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3651 h->hash = Fmake_vector (size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3652 h->next = Fmake_vector (size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3653 index_size = next_almost_prime (sz / XFLOATINT (rehash_threshold)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3654 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3655 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3656 /* Set up the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3657 for (i = 0; i < sz - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3658 HASH_NEXT (h, i) = make_number (i + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3659 h->next_free = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3660 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3661 XSET_HASH_TABLE (table, h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3662 xassert (HASH_TABLE_P (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3663 xassert (XHASH_TABLE (table) == h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3664 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3665 /* Maybe add this hash table to the list of all weak hash tables. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3666 if (NILP (h->weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3667 h->next_weak = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3668 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3669 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3670 h->next_weak = Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3671 Vweak_hash_tables = table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3672 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3673 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3674 return table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3675 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3676 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3677 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3678 /* Resize hash table H if it's too full. If H cannot be resized |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3679 because it's already too large, throw an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3680 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3681 static INLINE void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3682 maybe_resize_hash_table (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3683 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3684 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3685 if (NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3686 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3687 int old_size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3688 int i, new_size, index_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3689 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3690 if (INTEGERP (h->rehash_size)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3691 new_size = old_size + XFASTINT (h->rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3692 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3693 new_size = old_size * XFLOATINT (h->rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3694 index_size = next_almost_prime (new_size |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3695 / XFLOATINT (h->rehash_threshold)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3696 if (max (index_size, 2 * new_size) & ~VALMASK) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3697 error ("Hash table too large to resize"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3698 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3699 h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3700 h->next = larger_vector (h->next, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3701 h->hash = larger_vector (h->hash, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3702 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3703 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3704 /* Update the free list. Do it so that new entries are added at |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3705 the end of the free list. This makes some operations like |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3706 maphash faster. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3707 for (i = old_size; i < new_size - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3708 HASH_NEXT (h, i) = make_number (i + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3709 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3710 if (!NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3711 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3712 Lisp_Object last, next; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3713 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3714 last = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3715 while (next = HASH_NEXT (h, XFASTINT (last)), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3716 !NILP (next)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3717 last = next; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3718 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3719 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3720 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3721 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3722 XSETFASTINT (h->next_free, old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3723 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3724 /* Rehash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3725 for (i = 0; i < old_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3726 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3727 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3728 unsigned hash_code = XUINT (HASH_HASH (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3729 int start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3730 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3731 HASH_INDEX (h, start_of_bucket) = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3732 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3733 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3734 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3735 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3736 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3737 /* Lookup KEY in hash table H. If HASH is non-null, return in *HASH |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3738 the hash code of KEY. Value is the index of the entry in H |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3739 matching KEY, or -1 if not found. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3740 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3741 int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3742 hash_lookup (h, key, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3743 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3744 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3745 unsigned *hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3746 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3747 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3748 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3749 Lisp_Object idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3750 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3751 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3752 if (hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3753 *hash = hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3754 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3755 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3756 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3757 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3758 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3759 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3760 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3761 if (h->cmpfn (h, key, hash_code, HASH_KEY (h, i), HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3762 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3763 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3764 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3765 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3766 return NILP (idx) ? -1 : XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3767 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3768 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3769 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3770 /* Put an entry into hash table H that associates KEY with VALUE. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3771 HASH is a previously computed hash code of KEY. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3772 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3773 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3774 hash_put (h, key, value, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3775 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3776 Lisp_Object key, value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3777 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3778 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3779 int start_of_bucket, i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3780 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3781 xassert ((hash & ~VALMASK) == 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3782 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3783 /* Increment count after resizing because resizing may fail. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3784 maybe_resize_hash_table (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3785 h->count = make_number (XFASTINT (h->count) + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3786 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3787 /* Store key/value in the key_and_value vector. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3788 i = XFASTINT (h->next_free); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3789 h->next_free = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3790 HASH_KEY (h, i) = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3791 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3792 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3793 /* Remember its hash code. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3794 HASH_HASH (h, i) = make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3795 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3796 /* Add new entry to its collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3797 start_of_bucket = hash % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3798 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3799 HASH_INDEX (h, start_of_bucket) = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3800 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3801 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3802 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3803 /* Remove the entry matching KEY from hash table H, if there is one. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3804 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3805 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3806 hash_remove (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3807 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3808 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3809 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3810 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3811 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3812 Lisp_Object idx, prev; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3813 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3814 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3815 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3816 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3817 prev = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3818 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3819 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3820 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3821 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3822 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3823 if (h->cmpfn (h, key, hash_code, HASH_KEY (h, i), HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3824 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3825 /* Take entry out of collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3826 if (NILP (prev)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3827 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3828 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3829 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3830 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3831 /* Clear slots in key_and_value and add the slots to |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3832 the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3833 HASH_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3834 HASH_NEXT (h, i) = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3835 h->next_free = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3836 h->count = make_number (XFASTINT (h->count) - 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3837 xassert (XINT (h->count) >= 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3838 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3839 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3840 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3841 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3842 prev = idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3843 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3844 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3845 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3846 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3847 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3848 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3849 /* Clear hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3850 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3851 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3852 hash_clear (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3853 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3854 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3855 if (XFASTINT (h->count) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3856 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3857 int i, size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3858 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3859 for (i = 0; i < size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3860 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3861 HASH_NEXT (h, i) = i < size - 1 ? make_number (i + 1) : Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3862 HASH_KEY (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3863 HASH_VALUE (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3864 HASH_HASH (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3865 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3866 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3867 for (i = 0; i < XVECTOR (h->index)->size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3868 XVECTOR (h->index)->contents[i] = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3869 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3870 h->next_free = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3871 h->count = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3872 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3873 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3874 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3875 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3876 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3877 /************************************************************************ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3878 Weak Hash Tables |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3879 ************************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3880 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3881 /* Remove elements from weak hash tables that don't survive the |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3882 current garbage collection. Remove weak tables that don't survive |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3883 from Vweak_hash_tables. Called from gc_sweep. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3884 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3885 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3886 sweep_weak_hash_tables () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3887 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3888 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3889 struct Lisp_Hash_Table *h = 0, *prev; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3890 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3891 for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3892 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3893 prev = h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3894 h = XHASH_TABLE (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3895 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3896 if (h->size & ARRAY_MARK_FLAG) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3897 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3898 if (XFASTINT (h->count) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3899 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3900 int bucket, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3901 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3902 n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3903 for (bucket = 0; bucket < n; ++bucket) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3904 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3905 Lisp_Object idx, key, value, prev, next; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3906 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3907 /* Follow collision chain, removing entries that |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3908 don't survive this garbage collection. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3909 idx = HASH_INDEX (h, bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3910 prev = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3911 while (!GC_NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3912 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3913 int remove_p; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3914 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3915 Lisp_Object next; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3916 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3917 if (EQ (h->weak, Qkey_weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3918 remove_p = !survives_gc_p (HASH_KEY (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3919 else if (EQ (h->weak, Qvalue_weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3920 remove_p = !survives_gc_p (HASH_VALUE (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3921 else if (EQ (h->weak, Qkey_value_weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3922 remove_p = (!survives_gc_p (HASH_KEY (h, i)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3923 || !survives_gc_p (HASH_VALUE (h, i))); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3924 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3925 abort (); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3926 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3927 next = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3928 if (remove_p) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3929 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3930 /* Take out of collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3931 if (GC_NILP (prev)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3932 HASH_INDEX (h, i) = next; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3933 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3934 HASH_NEXT (h, XFASTINT (prev)) = next; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3935 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3936 /* Add to free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3937 HASH_NEXT (h, i) = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3938 h->next_free = idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3939 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3940 /* Clear key, value, and hash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3941 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3942 HASH_HASH (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3943 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3944 h->count = make_number (XFASTINT (h->count) - 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3945 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3946 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3947 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3948 /* Make sure key and value survive. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3949 mark_object (&HASH_KEY (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3950 mark_object (&HASH_VALUE (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3951 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3952 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3953 idx = next; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3954 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3955 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3956 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3957 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3958 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3959 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3960 /* Table is not marked, and will thus be freed. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3961 Take it out of the list of weak hash tables. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3962 if (prev) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3963 prev->next_weak = h->next_weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3964 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3965 Vweak_hash_tables = h->next_weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3966 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3967 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3968 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3969 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3970 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3971 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3972 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3973 Hash Code Computation |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3974 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3975 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3976 /* Maximum depth up to which to dive into Lisp structures. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3977 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3978 #define SXHASH_MAX_DEPTH 3 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3979 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3980 /* Maximum length up to which to take list and vector elements into |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3981 account. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3982 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3983 #define SXHASH_MAX_LEN 7 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3984 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3985 /* Combine two integers X and Y for hashing. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3986 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3987 #define SXHASH_COMBINE(X, Y) \ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3988 ((((unsigned)(X) << 4) + ((unsigned)(X) >> 24) & 0x0fffffff) \ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3989 + (unsigned)(Y)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3990 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3991 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3992 /* Return a hash for string PTR which has length LEN. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3993 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3994 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3995 sxhash_string (ptr, len) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3996 unsigned char *ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3997 int len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3998 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3999 unsigned char *p = ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4000 unsigned char *end = p + len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4001 unsigned char c; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4002 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4003 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4004 while (p != end) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4005 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4006 c = *p++; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4007 if (c >= 0140) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4008 c -= 40; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4009 hash = ((hash << 3) + (hash >> 28) + c); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4010 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4011 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4012 return hash & 07777777777; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4013 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4014 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4015 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4016 /* Return a hash for list LIST. DEPTH is the current depth in the |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4017 list. We don't recurse deeper than SXHASH_MAX_DEPTH in it. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4018 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4019 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4020 sxhash_list (list, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4021 Lisp_Object list; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4022 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4023 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4024 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4025 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4026 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4027 if (depth < SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4028 for (i = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4029 CONSP (list) && i < SXHASH_MAX_LEN; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4030 list = XCDR (list), ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4031 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4032 unsigned hash2 = sxhash (XCAR (list), depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4033 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4034 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4035 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4036 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4037 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4038 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4039 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4040 /* Return a hash for vector VECTOR. DEPTH is the current depth in |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4041 the Lisp structure. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4042 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4043 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4044 sxhash_vector (vec, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4045 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4046 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4047 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4048 unsigned hash = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4049 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4050 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4051 n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4052 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4053 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4054 unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4055 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4056 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4057 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4058 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4059 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4060 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4061 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4062 /* Return a hash for bool-vector VECTOR. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4063 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4064 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4065 sxhash_bool_vector (vec) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4066 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4067 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4068 unsigned hash = XBOOL_VECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4069 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4070 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4071 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4072 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4073 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4074 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4075 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4076 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4077 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4078 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4079 /* Return a hash code for OBJ. DEPTH is the current depth in the Lisp |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4080 structure. Value is an unsigned integer clipped to VALMASK. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4081 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4082 unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4083 sxhash (obj, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4084 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4085 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4086 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4087 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4088 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4089 if (depth > SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4090 return 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4091 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4092 switch (XTYPE (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4093 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4094 case Lisp_Int: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4095 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4096 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4097 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4098 case Lisp_Symbol: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4099 hash = sxhash_string (XSYMBOL (obj)->name->data, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4100 XSYMBOL (obj)->name->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4101 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4102 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4103 case Lisp_Misc: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4104 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4105 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4106 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4107 case Lisp_String: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4108 hash = sxhash_string (XSTRING (obj)->data, XSTRING (obj)->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4109 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4110 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4111 /* This can be everything from a vector to an overlay. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4112 case Lisp_Vectorlike: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4113 if (VECTORP (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4114 /* According to the CL HyperSpec, two arrays are equal only if |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4115 they are `eq', except for strings and bit-vectors. In |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4116 Emacs, this works differently. We have to compare element |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4117 by element. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4118 hash = sxhash_vector (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4119 else if (BOOL_VECTOR_P (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4120 hash = sxhash_bool_vector (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4121 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4122 /* Others are `equal' if they are `eq', so let's take their |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4123 address as hash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4124 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4125 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4126 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4127 case Lisp_Cons: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4128 hash = sxhash_list (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4129 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4130 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4131 case Lisp_Float: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4132 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4133 unsigned char *p = (unsigned char *) &XFLOAT (obj)->data; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4134 unsigned char *e = p + sizeof XFLOAT (obj)->data; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4135 for (hash = 0; p < e; ++p) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4136 hash = SXHASH_COMBINE (hash, *p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4137 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4138 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4139 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4140 default: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4141 abort (); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4142 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4143 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4144 return hash & VALMASK; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4145 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4146 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4147 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4148 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4149 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4150 Lisp Interface |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4151 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4152 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4153 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4154 DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4155 "Compute a hash code for OBJ and return it as integer.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4156 (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4157 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4158 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4159 unsigned hash = sxhash (obj, 0);; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4160 return make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4161 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4162 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4163 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4164 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4165 "Create and return a new hash table.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4166 Arguments are specified as keyword/argument pairs. The following\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4167 arguments are defined:\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4168 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4169 :TEST TEST -- TEST must be a symbol that specifies how to compare keys. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4170 Default is `eql'. Predefined are the tests `eq', `eql', and `equal'.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4171 User-supplied test and hash functions can be specified via\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4172 `define-hash-table-test'.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4173 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4174 :SIZE SIZE -- A hint as to how many elements will be put in the table. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4175 Default is 65.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4176 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4177 :REHASH-SIZE REHASH-SIZE - Indicates how to expand the table when\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4178 it fills up. If REHASH-SIZE is an integer, add that many space.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4179 If it is a float, it must be > 1.0, and the new size is computed by\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4180 multiplying the old size with that factor. Default is 1.5.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4181 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4182 :REHASH-THRESHOLD THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4183 Resize the hash table when ratio of the number of entries in the table.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4184 Default is 0.8.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4185 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4186 :WEAK WEAK -- WEAK must be one of nil, t, `key-weak', `value-weak' or\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4187 `key-value-weak'. WEAK t means the same as `key-value-weak'. Elements\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4188 are removed from a weak hash table when their key, value or both \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4189 according to WEAKNESS are otherwise unreferenced. Default is nil.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4190 (nargs, args) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4191 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4192 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4193 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4194 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4195 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4196 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4197 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4198 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4199 /* The vector `used' is used to keep track of arguments that |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4200 have been consumed. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4201 used = (char *) alloca (nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4202 bzero (used, nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4203 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4204 /* See if there's a `:test TEST' among the arguments. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4205 i = get_key_arg (QCtest, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4206 test = i < 0 ? Qeql : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4207 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4208 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4209 /* See if it is a user-defined test. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4210 Lisp_Object prop; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4211 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4212 prop = Fget (test, Qhash_table_test); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4213 if (!CONSP (prop) || XFASTINT (Flength (prop)) < 2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4214 Fsignal (Qerror, list2 (build_string ("Illegal hash table test"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4215 test)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4216 user_test = Fnth (make_number (0), prop); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4217 user_hash = Fnth (make_number (1), prop); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4218 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4219 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4220 user_test = user_hash = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4221 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4222 /* See if there's a `:size SIZE' argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4223 i = get_key_arg (QCsize, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4224 size = i < 0 ? make_number (DEFAULT_HASH_SIZE) : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4225 if (!INTEGERP (size) || XINT (size) <= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4226 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4227 list2 (build_string ("Illegal hash table size"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4228 size)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4229 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4230 /* Look for `:rehash-size SIZE'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4231 i = get_key_arg (QCrehash_size, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4232 rehash_size = i < 0 ? make_float (DEFAULT_REHASH_SIZE) : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4233 if (!NUMBERP (rehash_size) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4234 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4235 || XFLOATINT (rehash_size) <= 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4236 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4237 list2 (build_string ("Illegal hash table rehash size"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4238 rehash_size)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4239 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4240 /* Look for `:rehash-threshold THRESHOLD'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4241 i = get_key_arg (QCrehash_threshold, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4242 rehash_threshold = i < 0 ? make_float (DEFAULT_REHASH_THRESHOLD) : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4243 if (!FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4244 || XFLOATINT (rehash_threshold) <= 0.0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4245 || XFLOATINT (rehash_threshold) > 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4246 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4247 list2 (build_string ("Illegal hash table rehash threshold"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4248 rehash_threshold)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4249 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4250 /* Look for `:weak WEAK'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4251 i = get_key_arg (QCweak, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4252 weak = i < 0 ? Qnil : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4253 if (EQ (weak, Qt)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4254 weak = Qkey_value_weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4255 if (!NILP (weak) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4256 && !EQ (weak, Qkey_weak) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4257 && !EQ (weak, Qvalue_weak) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4258 && !EQ (weak, Qkey_value_weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4259 Fsignal (Qerror, list2 (build_string ("Illegal hash table weakness"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4260 weak)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4261 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4262 /* Now, all args should have been used up, or there's a problem. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4263 for (i = 0; i < nargs; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4264 if (!used[i]) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4265 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4266 list2 (build_string ("Invalid argument list"), args[i])); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4267 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4268 return make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4269 user_test, user_hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4270 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4271 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4272 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4273 DEFUN ("makehash", Fmakehash, Smakehash, 0, MANY, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4274 "Create a new hash table.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4275 Optional first argument SIZE is a hint to the implementation as\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4276 to how many elements will be put in the table. Default is 65.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4277 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4278 Optional second argument TEST specifies how to compare keys in\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4279 the table. Predefined tests are `eq', `eql', and `equal'. Default\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4280 is `eql'. New tests can be defined with `define-hash-table-test'.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4281 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4282 Optional third argument WEAK must be one of nil, t, `key-weak',\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4283 `value-weak' or `key-value-weak'. WEAK t means the same as\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4284 `key-value-weak'. Default is nil. Elements of weak hash tables\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4285 are removed when their key, value or both are otherwise unreferenced.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4286 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4287 The rest of the optional arguments are keyword/value pairs. The\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4288 following are recognized:\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4289 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4290 :REHASH-SIZE REHASH-SIZE - Indicates how to expand the table when\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4291 it fills up. If REHASH-SIZE is an integer, add that many space.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4292 If it is a float, it must be > 1.0, and the new size is computed by\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4293 multiplying the old size with that factor. Default is 1.5.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4294 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4295 :REHASH-THRESHOLD THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4296 Resize the hash table when ratio of the number of entries in the table.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4297 Default is 0.8.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4298 (nargs, args) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4299 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4300 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4301 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4302 Lisp_Object args2[nargs + 6]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4303 int i, j; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4304 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4305 /* Recognize size argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4306 i = j = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4307 if (INTEGERP (args[i])) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4308 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4309 args2[j++] = QCsize; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4310 args2[j++] = args[i++]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4311 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4312 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4313 /* Recognize test argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4314 if (SYMBOLP (args[i]) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4315 && !EQ (args[i], QCrehash_size) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4316 && !EQ (args[i], QCrehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4317 && !EQ (args[i], QCweak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4318 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4319 args2[j++] = QCtest; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4320 args2[j++] = args[i++]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4321 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4322 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4323 /* Recognize weakness argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4324 if (EQ (args[i], Qt) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4325 || NILP (args[i]) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4326 || EQ (args[i], Qkey_weak) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4327 || EQ (args[i], Qvalue_weak) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4328 || EQ (args[i], Qkey_value_weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4329 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4330 args2[j++] = QCweak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4331 args2[j++] = args[i++]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4332 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4333 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4334 /* Copy remaining arguments. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4335 while (i < nargs) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4336 args2[j++] = args[i++]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4337 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4338 return Fmake_hash_table (j, args2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4339 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4340 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4341 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4342 DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4343 "Return the number of elements in TABLE.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4344 (table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4345 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4346 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4347 return check_hash_table (table)->count; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4348 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4349 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4350 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4351 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4352 Shash_table_rehash_size, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4353 "Return the current rehash size of TABLE.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4354 (table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4355 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4356 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4357 return check_hash_table (table)->rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4358 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4359 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4360 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4361 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4362 Shash_table_rehash_threshold, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4363 "Return the current rehash threshold of TABLE.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4364 (table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4365 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4366 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4367 return check_hash_table (table)->rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4368 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4369 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4370 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4371 DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4372 "Return the size of TABLE.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4373 The size can be used as an argument to `make-hash-table' to create\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4374 a hash table than can hold as many elements of TABLE holds\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4375 without need for resizing.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4376 (table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4377 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4378 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4379 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4380 return make_number (HASH_TABLE_SIZE (h)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4381 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4382 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4383 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4384 DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4385 "Return the test TABLE uses.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4386 (table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4387 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4388 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4389 return check_hash_table (table)->test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4390 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4391 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4392 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4393 DEFUN ("hash-table-weak", Fhash_table_weak, Shash_table_weak, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4394 "Return the weakness of TABLE.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4395 (table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4396 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4397 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4398 return check_hash_table (table)->weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4399 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4400 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4401 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4402 DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4403 "Return t if OBJ is a Lisp hash table object.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4404 (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4405 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4406 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4407 return HASH_TABLE_P (obj) ? Qt : Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4408 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4409 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4410 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4411 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4412 "Clear hash table TABLE.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4413 (table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4414 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4415 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4416 hash_clear (check_hash_table (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4417 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4418 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4419 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4420 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4421 DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4422 "Look up KEY in TABLE and return its associated value.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4423 If KEY is not found, return DFLT which defaults to nil.") |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4424 (key, table, dflt) |
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4425 Lisp_Object key, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4426 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4427 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4428 int i = hash_lookup (h, key, NULL); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4429 return i >= 0 ? HASH_VALUE (h, i) : dflt; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4430 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4431 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4432 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4433 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4434 "Associate KEY with VALUE is hash table TABLE.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4435 If KEY is already present in table, replace its current value with\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4436 VALUE.") |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4437 (key, value, table) |
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4438 Lisp_Object key, value, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4439 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4440 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4441 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4442 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4443 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4444 i = hash_lookup (h, key, &hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4445 if (i >= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4446 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4447 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4448 hash_put (h, key, value, hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4449 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4450 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4451 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4452 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4453 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4454 DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4455 "Remove KEY from TABLE.") |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4456 (key, table) |
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4457 Lisp_Object key, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4458 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4459 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4460 hash_remove (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4461 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4462 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4463 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4464 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4465 DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4466 "Call FUNCTION for all entries in hash table TABLE.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4467 FUNCTION is called with 2 arguments KEY and VALUE.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4468 (function, table) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4469 Lisp_Object function, table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4470 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4471 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4472 Lisp_Object args[3]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4473 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4474 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4475 for (i = 0; i < HASH_TABLE_SIZE (h); ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4476 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4477 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4478 args[0] = function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4479 args[1] = HASH_KEY (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4480 args[2] = HASH_VALUE (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4481 Ffuncall (3, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4482 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4483 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4484 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4485 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4486 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4487 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4488 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4489 Sdefine_hash_table_test, 3, 3, 0, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4490 "Define a new hash table test with name NAME, a symbol.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4491 In hash tables create with NAME specified as test, use TEST to compare\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4492 keys, and HASH for computing hash codes of keys.\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4493 \n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4494 TEST must be a function taking two arguments and returning non-nil\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4495 if both arguments are the same. HASH must be a function taking\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4496 one argument and return an integer that is the hash code of the\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4497 argument. Hash code computation should use the whole value range of\n\ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4498 integers, including negative integers.") |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4499 (name, test, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4500 Lisp_Object name, test, hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4501 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4502 return Fput (name, Qhash_table_test, list2 (test, hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4503 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4504 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4505 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4506 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4507 |
21514 | 4508 void |
211 | 4509 syms_of_fns () |
4510 { | |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4511 /* Hash table stuff. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4512 Qhash_table_p = intern ("hash-table-p"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4513 staticpro (&Qhash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4514 Qeq = intern ("eq"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4515 staticpro (&Qeq); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4516 Qeql = intern ("eql"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4517 staticpro (&Qeql); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4518 Qequal = intern ("equal"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4519 staticpro (&Qequal); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4520 QCtest = intern (":test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4521 staticpro (&QCtest); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4522 QCsize = intern (":size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4523 staticpro (&QCsize); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4524 QCrehash_size = intern (":rehash-size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4525 staticpro (&QCrehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4526 QCrehash_threshold = intern (":rehash-threshold"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4527 staticpro (&QCrehash_threshold); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4528 QCweak = intern (":weak"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4529 staticpro (&QCweak); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4530 Qkey_weak = intern ("key-weak"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4531 staticpro (&Qkey_weak); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4532 Qvalue_weak = intern ("value-weak"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4533 staticpro (&Qvalue_weak); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4534 Qkey_value_weak = intern ("key-value-weak"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4535 staticpro (&Qkey_value_weak); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4536 Qhash_table_test = intern ("hash-table-test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4537 staticpro (&Qhash_table_test); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4538 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4539 defsubr (&Ssxhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4540 defsubr (&Smake_hash_table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4541 defsubr (&Smakehash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4542 defsubr (&Shash_table_count); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4543 defsubr (&Shash_table_rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4544 defsubr (&Shash_table_rehash_threshold); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4545 defsubr (&Shash_table_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4546 defsubr (&Shash_table_test); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4547 defsubr (&Shash_table_weak); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4548 defsubr (&Shash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4549 defsubr (&Sclrhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4550 defsubr (&Sgethash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4551 defsubr (&Sputhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4552 defsubr (&Sremhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4553 defsubr (&Smaphash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4554 defsubr (&Sdefine_hash_table_test); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4555 |
211 | 4556 Qstring_lessp = intern ("string-lessp"); |
4557 staticpro (&Qstring_lessp); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
4558 Qprovide = intern ("provide"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
4559 staticpro (&Qprovide); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
4560 Qrequire = intern ("require"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
4561 staticpro (&Qrequire); |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
4562 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
|
4563 staticpro (&Qyes_or_no_p_history); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
4564 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
|
4565 staticpro (&Qcursor_in_echo_area); |
20004 | 4566 Qwidget_type = intern ("widget-type"); |
4567 staticpro (&Qwidget_type); | |
211 | 4568 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
4569 staticpro (&string_char_byte_cache_string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
4570 string_char_byte_cache_string = Qnil; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
4571 |
14486
3c4ba112108e
(syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents:
14456
diff
changeset
|
4572 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
|
4573 |
211 | 4574 DEFVAR_LISP ("features", &Vfeatures, |
4575 "A list of symbols which are the features of the executing emacs.\n\ | |
4576 Used by `featurep' and `require', and altered by `provide'."); | |
4577 Vfeatures = Qnil; | |
4578 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
4579 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
|
4580 "*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
|
4581 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
|
4582 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
|
4583 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
|
4584 |
211 | 4585 defsubr (&Sidentity); |
4586 defsubr (&Srandom); | |
4587 defsubr (&Slength); | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
4588 defsubr (&Ssafe_length); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
4589 defsubr (&Sstring_bytes); |
211 | 4590 defsubr (&Sstring_equal); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
4591 defsubr (&Scompare_strings); |
211 | 4592 defsubr (&Sstring_lessp); |
4593 defsubr (&Sappend); | |
4594 defsubr (&Sconcat); | |
4595 defsubr (&Svconcat); | |
4596 defsubr (&Scopy_sequence); | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
4597 defsubr (&Sstring_make_multibyte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
4598 defsubr (&Sstring_make_unibyte); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
4599 defsubr (&Sstring_as_multibyte); |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
4600 defsubr (&Sstring_as_unibyte); |
211 | 4601 defsubr (&Scopy_alist); |
4602 defsubr (&Ssubstring); | |
4603 defsubr (&Snthcdr); | |
4604 defsubr (&Snth); | |
4605 defsubr (&Selt); | |
4606 defsubr (&Smember); | |
4607 defsubr (&Smemq); | |
4608 defsubr (&Sassq); | |
4609 defsubr (&Sassoc); | |
4610 defsubr (&Srassq); | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
4611 defsubr (&Srassoc); |
211 | 4612 defsubr (&Sdelq); |
414 | 4613 defsubr (&Sdelete); |
211 | 4614 defsubr (&Snreverse); |
4615 defsubr (&Sreverse); | |
4616 defsubr (&Ssort); | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
4617 defsubr (&Splist_get); |
211 | 4618 defsubr (&Sget); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
4619 defsubr (&Splist_put); |
211 | 4620 defsubr (&Sput); |
4621 defsubr (&Sequal); | |
4622 defsubr (&Sfillarray); | |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
4623 defsubr (&Schar_table_subtype); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
4624 defsubr (&Schar_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
4625 defsubr (&Sset_char_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
4626 defsubr (&Schar_table_extra_slot); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
4627 defsubr (&Sset_char_table_extra_slot); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
4628 defsubr (&Schar_table_range); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
4629 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
|
4630 defsubr (&Sset_char_table_default); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
4631 defsubr (&Smap_char_table); |
211 | 4632 defsubr (&Snconc); |
4633 defsubr (&Smapcar); | |
4634 defsubr (&Smapconcat); | |
4635 defsubr (&Sy_or_n_p); | |
4636 defsubr (&Syes_or_no_p); | |
4637 defsubr (&Sload_average); | |
4638 defsubr (&Sfeaturep); | |
4639 defsubr (&Srequire); | |
4640 defsubr (&Sprovide); | |
20004 | 4641 defsubr (&Swidget_plist_member); |
4642 defsubr (&Swidget_put); | |
4643 defsubr (&Swidget_get); | |
4644 defsubr (&Swidget_apply); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4645 defsubr (&Sbase64_encode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4646 defsubr (&Sbase64_decode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4647 defsubr (&Sbase64_encode_string); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4648 defsubr (&Sbase64_decode_string); |
211 | 4649 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4650 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4651 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4652 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4653 init_fns () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4654 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4655 Vweak_hash_tables = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4656 } |