Mercurial > emacs
annotate src/fns.c @ 50837:1bd0d75dbaa9
(byte-compile-file): Fix comment
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Tue, 06 May 2003 05:09:48 +0000 |
parents | 6a4e89f0d078 |
children | 663da44e6176 |
rev | line source |
---|---|
211 | 1 /* Random utility Lisp functions. |
48337 | 2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 2002 |
34050 | 3 Free Software Foundation, Inc. |
211 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 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
|
9 the Free Software Foundation; either version 2, or (at your option) |
211 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 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
|
19 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
|
20 Boston, MA 02111-1307, USA. */ |
211 | 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 |
50301
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
29 #ifndef MAC_OSX |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
30 /* On Mac OS X, defining this conflicts with precompiled headers. */ |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
31 |
211 | 32 /* Note on some machines this defines `vector' as a typedef, |
33 so make sure we don't use that name in this file. */ | |
34 #undef vector | |
35 #define vector ***** | |
50301
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
36 |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
37 #endif /* ! MAC_OSX */ |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
38 |
211 | 39 #include "lisp.h" |
40 #include "commands.h" | |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
41 #include "charset.h" |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
42 #include "coding.h" |
211 | 43 #include "buffer.h" |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
44 #include "keyboard.h" |
39697
0b986bb45526
Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39682
diff
changeset
|
45 #include "keymap.h" |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
46 #include "intervals.h" |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
47 #include "frame.h" |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
48 #include "window.h" |
37319 | 49 #include "blockinput.h" |
21810
15f5abff4d9b
[HAVE_MENUS]: Include xterm.h only if HAVE_X_WINDOWS.
Richard M. Stallman <rms@gnu.org>
parents:
21791
diff
changeset
|
50 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS) |
21514 | 51 #include "xterm.h" |
52 #endif | |
211 | 53 |
12062 | 54 #ifndef NULL |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
55 #define NULL ((POINTER_TYPE *)0) |
12062 | 56 #endif |
57 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
58 /* 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
|
59 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
|
60 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
|
61 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
62 extern int minibuffer_auto_raise; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
63 extern Lisp_Object minibuf_window; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
64 extern Lisp_Object Vlocale_coding_system; |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
65 |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
66 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
|
67 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
|
68 Lisp_Object Qcursor_in_echo_area; |
20004 | 69 Lisp_Object Qwidget_type; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
70 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; |
211 | 71 |
23051
18ed8d6b11e5
(Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents:
22853
diff
changeset
|
72 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
|
73 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
74 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
|
75 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
76 extern long get_random (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
77 extern void seed_random (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
78 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
79 #ifndef HAVE_UNISTD_H |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
80 extern long time (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
81 #endif |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
82 |
211 | 83 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
41006 | 84 doc: /* Return the argument unchanged. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
85 (arg) |
211 | 86 Lisp_Object arg; |
87 { | |
88 return arg; | |
89 } | |
90 | |
91 DEFUN ("random", Frandom, Srandom, 0, 1, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
92 doc: /* Return a pseudo-random number. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
93 All integers representable in Lisp are equally likely. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
94 On most systems, this is 28 bits' worth. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
95 With positive integer argument N, return random number in interval [0,N). |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
96 With argument t, set the random number seed from the current time and pid. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
97 (n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
98 Lisp_Object n; |
211 | 99 { |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
100 EMACS_INT val; |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
101 Lisp_Object lispy_val; |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
102 unsigned long denominator; |
211 | 103 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
104 if (EQ (n, Qt)) |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
105 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
|
106 if (NATNUMP (n) && XFASTINT (n) != 0) |
211 | 107 { |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
108 /* 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
|
109 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
|
110 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
|
111 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
|
112 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
|
113 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
|
114 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
|
115 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
116 do |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
117 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
|
118 while (val >= XFASTINT (n)); |
211 | 119 } |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
120 else |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
121 val = get_random (); |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
122 XSETINT (lispy_val, val); |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
123 return lispy_val; |
211 | 124 } |
125 | |
126 /* Random data-structure functions */ | |
127 | |
128 DEFUN ("length", Flength, Slength, 1, 1, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
129 doc: /* Return the length of vector, list or string SEQUENCE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
130 A byte-code function object is also allowed. |
47762 | 131 If the string contains multibyte characters, this is not necessarily |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
132 the number of bytes in the string; it is the number of characters. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
133 To get the number of bytes, use `string-bytes'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
134 (sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
135 register Lisp_Object sequence; |
211 | 136 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
137 register Lisp_Object val; |
211 | 138 register int i; |
139 | |
140 retry: | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
141 if (STRINGP (sequence)) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
142 XSETFASTINT (val, SCHARS (sequence)); |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
143 else if (VECTORP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
144 XSETFASTINT (val, XVECTOR (sequence)->size); |
50461
6a4e89f0d078
(Flength): Return SUB_CHAR_TABLE_ORDINARY_SLOTS for sub char tables.
Juanma Barranquero <lekktu@gmail.com>
parents:
50301
diff
changeset
|
145 else if (SUB_CHAR_TABLE_P (sequence)) |
6a4e89f0d078
(Flength): Return SUB_CHAR_TABLE_ORDINARY_SLOTS for sub char tables.
Juanma Barranquero <lekktu@gmail.com>
parents:
50301
diff
changeset
|
146 XSETFASTINT (val, SUB_CHAR_TABLE_ORDINARY_SLOTS); |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
147 else if (CHAR_TABLE_P (sequence)) |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
148 XSETFASTINT (val, MAX_CHAR); |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
149 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
|
150 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
|
151 else if (COMPILEDP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
152 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
|
153 else if (CONSP (sequence)) |
211 | 154 { |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
155 i = 0; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
156 while (CONSP (sequence)) |
211 | 157 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
158 sequence = XCDR (sequence); |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
159 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
160 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
161 if (!CONSP (sequence)) |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
162 break; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
163 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
164 sequence = XCDR (sequence); |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
165 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
166 QUIT; |
211 | 167 } |
168 | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
169 if (!NILP (sequence)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
170 wrong_type_argument (Qlistp, sequence); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
171 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
172 val = make_number (i); |
211 | 173 } |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
174 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
|
175 XSETFASTINT (val, 0); |
211 | 176 else |
177 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
178 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 179 goto retry; |
180 } | |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
181 return val; |
211 | 182 } |
183 | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
184 /* This does not check for quits. That is safe |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
185 since it must terminate. */ |
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 DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
188 doc: /* Return the length of a list, but avoid error or infinite loop. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
189 This function never gets an error. If LIST is not really a list, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
190 it returns 0. If LIST is circular, it returns a finite value |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
191 which is at least the number of distinct elements. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
192 (list) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
193 Lisp_Object list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
194 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
195 Lisp_Object tail, halftail, length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
196 int len = 0; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
197 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
198 /* halftail is used to detect circular lists. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
199 halftail = list; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
200 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
201 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
202 if (EQ (tail, halftail) && len != 0) |
12618
60c4c0fee545
(Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents:
12466
diff
changeset
|
203 break; |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
204 len++; |
13344
30e17254a280
(Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents:
13277
diff
changeset
|
205 if ((len & 1) == 0) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
206 halftail = XCDR (halftail); |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
207 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
208 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
209 XSETINT (length, len); |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
210 return length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
211 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
212 |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
213 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
214 doc: /* Return the number of bytes in STRING. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
215 If STRING is a multibyte string, this is greater than the length of STRING. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
216 (string) |
20881
fd35cf0efd94
(Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents:
20880
diff
changeset
|
217 Lisp_Object string; |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
218 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
219 CHECK_STRING (string); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
220 return make_number (SBYTES (string)); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
221 } |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
222 |
211 | 223 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
224 doc: /* Return t if two strings have identical contents. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
225 Case is significant, but text properties are ignored. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
226 Symbols are also allowed; their print names are used instead. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
227 (s1, s2) |
211 | 228 register Lisp_Object s1, s2; |
229 { | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
230 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
231 s1 = SYMBOL_NAME (s1); |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
232 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
233 s2 = SYMBOL_NAME (s2); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
234 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
235 CHECK_STRING (s2); |
211 | 236 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
237 if (SCHARS (s1) != SCHARS (s2) |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
238 || SBYTES (s1) != SBYTES (s2) |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
239 || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1))) |
211 | 240 return Qnil; |
241 return Qt; | |
242 } | |
243 | |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
244 DEFUN ("compare-strings", Fcompare_strings, |
21673
8a32bf93da04
(Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents:
21671
diff
changeset
|
245 Scompare_strings, 6, 7, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
246 doc: /* Compare the contents of two strings, converting to multibyte if needed. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
247 In string STR1, skip the first START1 characters and stop at END1. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
248 In string STR2, skip the first START2 characters and stop at END2. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
249 END1 and END2 default to the full lengths of the respective strings. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
250 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
251 Case is significant in this comparison if IGNORE-CASE is nil. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
252 Unibyte strings are converted to multibyte for comparison. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
253 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
254 The value is t if the strings (or specified portions) match. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
255 If string STR1 is less, the value is a negative number N; |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
256 - 1 - N is the number of characters that match at the beginning. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
257 If string STR1 is greater, the value is a positive number N; |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
258 N - 1 is the number of characters that match at the beginning. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
259 (str1, start1, end1, str2, start2, end2, ignore_case) |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
260 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
|
261 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
262 register int end1_char, end2_char; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
263 register int i1, i1_byte, i2, i2_byte; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
264 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
265 CHECK_STRING (str1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
266 CHECK_STRING (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
267 if (NILP (start1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
268 start1 = make_number (0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
269 if (NILP (start2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
270 start2 = make_number (0); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
271 CHECK_NATNUM (start1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
272 CHECK_NATNUM (start2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
273 if (! NILP (end1)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
274 CHECK_NATNUM (end1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
275 if (! NILP (end2)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
276 CHECK_NATNUM (end2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
277 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
278 i1 = XINT (start1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
279 i2 = XINT (start2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
280 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
281 i1_byte = string_char_to_byte (str1, i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
282 i2_byte = string_char_to_byte (str2, i2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
283 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
284 end1_char = SCHARS (str1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
285 if (! NILP (end1) && end1_char > XINT (end1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
286 end1_char = XINT (end1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
287 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
288 end2_char = SCHARS (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
289 if (! NILP (end2) && end2_char > XINT (end2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
290 end2_char = XINT (end2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
291 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
292 while (i1 < end1_char && i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
293 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
294 /* When we find a mismatch, we must compare the |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
295 characters, not just the bytes. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
296 int c1, 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 if (STRING_MULTIBYTE (str1)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
299 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
300 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
301 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
302 c1 = SREF (str1, i1++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
303 c1 = unibyte_char_to_multibyte (c1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
304 } |
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 if (STRING_MULTIBYTE (str2)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
307 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
308 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
309 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
310 c2 = SREF (str2, i2++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
311 c2 = unibyte_char_to_multibyte (c2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
312 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
313 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
314 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
315 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
316 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
317 if (! NILP (ignore_case)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
318 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
319 Lisp_Object tem; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
320 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
321 tem = Fupcase (make_number (c1)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
322 c1 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
323 tem = Fupcase (make_number (c2)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
324 c2 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
325 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
326 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
327 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
328 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
329 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
330 /* Note that I1 has already been incremented |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
331 past the character that we are comparing; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
332 hence we don't add or subtract 1 here. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
333 if (c1 < c2) |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
334 return make_number (- i1 + XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
335 else |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
336 return make_number (i1 - XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
337 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
338 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
339 if (i1 < end1_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
340 return make_number (i1 - XINT (start1) + 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
341 if (i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
342 return make_number (- i1 + XINT (start1) - 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
343 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
344 return Qt; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
345 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
346 |
211 | 347 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
348 doc: /* Return t if first arg string is less than second in lexicographic order. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
349 Case is significant. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
350 Symbols are also allowed; their print names are used instead. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
351 (s1, s2) |
211 | 352 register Lisp_Object s1, s2; |
353 { | |
354 register int end; | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
355 register int i1, i1_byte, i2, i2_byte; |
211 | 356 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
357 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
358 s1 = SYMBOL_NAME (s1); |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
359 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
360 s2 = SYMBOL_NAME (s2); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
361 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
362 CHECK_STRING (s2); |
211 | 363 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
364 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
|
365 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
366 end = SCHARS (s1); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
367 if (end > SCHARS (s2)) |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
368 end = SCHARS (s2); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
369 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
370 while (i1 < end) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
371 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
372 /* 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
|
373 characters, not just the bytes. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
374 int c1, c2; |
211 | 375 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
376 FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
377 FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
378 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
379 if (c1 != c2) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
380 return c1 < c2 ? Qt : Qnil; |
211 | 381 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
382 return i1 < SCHARS (s2) ? Qt : Qnil; |
211 | 383 } |
384 | |
385 static Lisp_Object concat (); | |
386 | |
387 /* ARGSUSED */ | |
388 Lisp_Object | |
389 concat2 (s1, s2) | |
390 Lisp_Object s1, s2; | |
391 { | |
392 #ifdef NO_ARG_ARRAY | |
393 Lisp_Object args[2]; | |
394 args[0] = s1; | |
395 args[1] = s2; | |
396 return concat (2, args, Lisp_String, 0); | |
397 #else | |
398 return concat (2, &s1, Lisp_String, 0); | |
399 #endif /* NO_ARG_ARRAY */ | |
400 } | |
401 | |
8966
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
402 /* ARGSUSED */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
403 Lisp_Object |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
404 concat3 (s1, s2, s3) |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
405 Lisp_Object s1, s2, s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
406 { |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
407 #ifdef NO_ARG_ARRAY |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
408 Lisp_Object args[3]; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
409 args[0] = s1; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
410 args[1] = s2; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
411 args[2] = s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
412 return concat (3, args, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
413 #else |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
414 return concat (3, &s1, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
415 #endif /* NO_ARG_ARRAY */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
416 } |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
417 |
211 | 418 DEFUN ("append", Fappend, Sappend, 0, MANY, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
419 doc: /* Concatenate all the arguments and make the result a list. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
420 The result is a list whose elements are the elements of all the arguments. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
421 Each argument may be a list, vector or string. |
40132
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
422 The last argument is not copied, just used as the tail of the new list. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
423 usage: (append &rest SEQUENCES) */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
424 (nargs, args) |
211 | 425 int nargs; |
426 Lisp_Object *args; | |
427 { | |
428 return concat (nargs, args, Lisp_Cons, 1); | |
429 } | |
430 | |
431 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
432 doc: /* Concatenate all the arguments and make the result a string. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
433 The result is a string whose elements are the elements of all the arguments. |
40132
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
434 Each argument may be a string or a list or vector of characters (integers). |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
435 usage: (concat &rest SEQUENCES) */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
436 (nargs, args) |
211 | 437 int nargs; |
438 Lisp_Object *args; | |
439 { | |
440 return concat (nargs, args, Lisp_String, 0); | |
441 } | |
442 | |
443 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
444 doc: /* Concatenate all the arguments and make the result a vector. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
445 The result is a vector whose elements are the elements of all the arguments. |
40132
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
446 Each argument may be a list, vector or string. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
447 usage: (vconcat &rest SEQUENCES) */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
448 (nargs, args) |
211 | 449 int nargs; |
450 Lisp_Object *args; | |
451 { | |
10006
402c87cbc4fa
(Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9965
diff
changeset
|
452 return concat (nargs, args, Lisp_Vectorlike, 0); |
211 | 453 } |
454 | |
47762 | 455 /* Return a copy of a sub char table ARG. The elements except for a |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
456 nested sub char table are not copied. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
457 static Lisp_Object |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
458 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
|
459 Lisp_Object arg; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
460 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
461 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
|
462 int i; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
463 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
464 /* Copy all the contents. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
465 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
|
466 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
467 /* 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
|
468 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
|
469 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
|
470 XCHAR_TABLE (copy)->contents[i] |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
471 = 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
|
472 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
473 return copy; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
474 } |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
475 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
476 |
211 | 477 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, |
48320 | 478 doc: /* Return a copy of a list, vector, string or char-table. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
479 The elements of a list or vector are not copied; they are shared |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
480 with the original. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
481 (arg) |
211 | 482 Lisp_Object arg; |
483 { | |
485 | 484 if (NILP (arg)) return arg; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
485 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
486 if (CHAR_TABLE_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
487 { |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
488 int i; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
489 Lisp_Object copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
490 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
491 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
|
492 /* 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
|
493 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
494 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) |
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
495 * sizeof (Lisp_Object))); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
496 |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
497 /* 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
|
498 for multibyte characters. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
499 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
500 i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
501 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
|
502 XCHAR_TABLE (copy)->contents[i] |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
503 = 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
|
504 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
505 return copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
506 } |
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 if (BOOL_VECTOR_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
509 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
510 Lisp_Object val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
511 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
512 = (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
|
513 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
514 val = Fmake_bool_vector (Flength (arg), Qnil); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
515 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
|
516 size_in_chars); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
517 return val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
518 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
519 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
520 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) |
211 | 521 arg = wrong_type_argument (Qsequencep, arg); |
522 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); | |
523 } | |
524 | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
525 /* 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
|
526 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
|
527 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
|
528 Otherwize, return 0. */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
529 |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
530 static int |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
531 count_combining (str, len, i) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
532 unsigned char *str; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
533 int len, i; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
534 { |
25501
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
535 int j = i - 1, bytes; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
536 |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
537 if (i == 0 || i == len || CHAR_HEAD_P (str[i])) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
538 return 0; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
539 while (j >= 0 && !CHAR_HEAD_P (str[j])) j--; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
540 if (j < 0 || ! BASE_LEADING_CODE_P (str[j])) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
541 return 0; |
25501
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
542 PARSE_MULTIBYTE_SEQ (str + j, len - j, bytes); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
543 return (bytes <= i - j ? 0 : bytes - (i - j)); |
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 |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
546 /* 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
|
547 a string and has text properties to be copied. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
548 struct textprop_rec |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
549 { |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
550 int argnum; /* refer to ARGS (arguments of `concat') */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
551 int from; /* refer to ARGS[argnum] (argument string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
552 int to; /* refer to VAL (the target string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
553 }; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
554 |
211 | 555 static Lisp_Object |
556 concat (nargs, args, target_type, last_special) | |
557 int nargs; | |
558 Lisp_Object *args; | |
559 enum Lisp_Type target_type; | |
560 int last_special; | |
561 { | |
562 Lisp_Object val; | |
563 register Lisp_Object tail; | |
564 register Lisp_Object this; | |
565 int toindex; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
566 int toindex_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
567 register int result_len; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
568 register int result_len_byte; |
211 | 569 register int argnum; |
570 Lisp_Object last_tail; | |
571 Lisp_Object prev; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
572 int some_multibyte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
573 /* 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
|
574 while concatinating each string because the length of resulting |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
575 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
|
576 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
|
577 here, and copy the text properties after the concatination. */ |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
578 struct textprop_rec *textprops = NULL; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
579 /* Number of elments in textprops. */ |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
580 int num_textprops = 0; |
211 | 581 |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
582 tail = Qnil; |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
583 |
211 | 584 /* In append, the last arg isn't treated like the others */ |
585 if (last_special && nargs > 0) | |
586 { | |
587 nargs--; | |
588 last_tail = args[nargs]; | |
589 } | |
590 else | |
591 last_tail = Qnil; | |
592 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
593 /* Canonicalize each argument. */ |
211 | 594 for (argnum = 0; argnum < nargs; argnum++) |
595 { | |
596 this = args[argnum]; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
597 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
|
598 || COMPILEDP (this) || BOOL_VECTOR_P (this))) |
211 | 599 { |
600 args[argnum] = wrong_type_argument (Qsequencep, this); | |
601 } | |
602 } | |
603 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
604 /* 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
|
605 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
|
606 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
|
607 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
|
608 result_len_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
609 result_len = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
610 some_multibyte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
611 for (argnum = 0; argnum < nargs; argnum++) |
211 | 612 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
613 int len; |
211 | 614 this = args[argnum]; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
615 len = XFASTINT (Flength (this)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
616 if (target_type == Lisp_String) |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
617 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
618 /* 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
|
619 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
|
620 int i; |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
621 Lisp_Object ch; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
622 int this_len_byte; |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
623 |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
624 if (VECTORP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
625 for (i = 0; i < len; i++) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
626 { |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
627 ch = XVECTOR (this)->contents[i]; |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
628 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
629 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
|
630 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
|
631 result_len_byte += this_len_byte; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
632 if (!SINGLE_BYTE_CHAR_P (XINT (ch))) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
633 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
634 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
635 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
|
636 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
|
637 else if (CONSP (this)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
638 for (; CONSP (this); this = XCDR (this)) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
639 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
640 ch = XCAR (this); |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
641 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
642 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
|
643 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
|
644 result_len_byte += this_len_byte; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
645 if (!SINGLE_BYTE_CHAR_P (XINT (ch))) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
646 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
647 } |
20639
12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents:
20607
diff
changeset
|
648 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
649 { |
20699
907d8633c8cc
(concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents:
20667
diff
changeset
|
650 if (STRING_MULTIBYTE (this)) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
651 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
652 some_multibyte = 1; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
653 result_len_byte += SBYTES (this); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
654 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
655 else |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
656 result_len_byte += count_size_as_multibyte (SDATA (this), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
657 SCHARS (this)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
658 } |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
659 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
660 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
661 result_len += len; |
211 | 662 } |
663 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
664 if (! some_multibyte) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
665 result_len_byte = result_len; |
211 | 666 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
667 /* Create the output object. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
668 if (target_type == Lisp_Cons) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
669 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
|
670 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
|
671 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
|
672 else if (some_multibyte) |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
673 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
|
674 else |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
675 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
|
676 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
677 /* 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
|
678 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
|
679 return last_tail; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
680 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
681 /* Copy the contents of the args into the result. */ |
211 | 682 if (CONSP (val)) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
683 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ |
211 | 684 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
685 toindex = 0, toindex_byte = 0; |
211 | 686 |
687 prev = Qnil; | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
688 if (STRINGP (val)) |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
689 textprops |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
690 = (struct textprop_rec *) alloca (sizeof (struct textprop_rec) * nargs); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
691 |
211 | 692 for (argnum = 0; argnum < nargs; argnum++) |
693 { | |
694 Lisp_Object thislen; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
695 int thisleni = 0; |
16863
591b7a95d7a5
(concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents:
16561
diff
changeset
|
696 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
|
697 register unsigned int thisindex_byte = 0; |
211 | 698 |
699 this = args[argnum]; | |
700 if (!CONSP (this)) | |
701 thislen = Flength (this), thisleni = XINT (thislen); | |
702 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
703 /* 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
|
704 if (STRINGP (this) && STRINGP (val) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
705 && 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
|
706 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
707 int thislen_byte = SBYTES (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
708 int combined; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
709 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
710 bcopy (SDATA (this), SDATA (val) + toindex_byte, |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
711 SBYTES (this)); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
712 combined = (some_multibyte && toindex_byte > 0 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
713 ? count_combining (SDATA (val), |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
714 toindex_byte + thislen_byte, |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
715 toindex_byte) |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
716 : 0); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
717 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
718 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
719 textprops[num_textprops].argnum = argnum; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
720 /* We ignore text properties on characters being combined. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
721 textprops[num_textprops].from = combined; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
722 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
723 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
724 toindex_byte += thislen_byte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
725 toindex += thisleni - combined; |
46374
5d419e7c527d
* fns.c (concat): Use STRING_SET_CHARS.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
726 STRING_SET_CHARS (val, SCHARS (val) - combined); |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
727 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
728 /* 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
|
729 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
|
730 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
731 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
732 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
733 textprops[num_textprops].argnum = argnum; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
734 textprops[num_textprops].from = 0; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
735 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
736 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
737 toindex_byte += copy_text (SDATA (this), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
738 SDATA (val) + toindex_byte, |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
739 SCHARS (this), 0, 1); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
740 toindex += thisleni; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
741 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
742 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
743 /* Copy element by element. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
744 while (1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
745 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
746 register Lisp_Object elt; |
211 | 747 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
748 /* 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
|
749 `this' is exhausted. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
750 if (NILP (this)) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
751 if (CONSP (this)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
752 elt = XCAR (this), this = XCDR (this); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
753 else if (thisindex >= thisleni) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
754 break; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
755 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
756 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
757 int c; |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
758 if (STRING_MULTIBYTE (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
759 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
760 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
761 thisindex, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
762 thisindex_byte); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
763 XSETFASTINT (elt, c); |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
764 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
765 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
766 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
767 XSETFASTINT (elt, SREF (this, thisindex++)); |
23152
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
768 if (some_multibyte |
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
769 && (XINT (elt) >= 0240 |
23927
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
770 || (XINT (elt) >= 0200 |
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
771 && ! NILP (Vnonascii_translation_table))) |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
772 && XINT (elt) < 0400) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
773 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
774 c = unibyte_char_to_multibyte (XINT (elt)); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
775 XSETINT (elt, c); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
776 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
777 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
778 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
779 else if (BOOL_VECTOR_P (this)) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
780 { |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
781 int byte; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
782 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
|
783 if (byte & (1 << (thisindex % BITS_PER_CHAR))) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
784 elt = Qt; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
785 else |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
786 elt = Qnil; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
787 thisindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
788 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
789 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
790 elt = XVECTOR (this)->contents[thisindex++]; |
211 | 791 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
792 /* 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
|
793 if (toindex < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
794 { |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
795 XSETCAR (tail, elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
796 prev = tail; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
797 tail = XCDR (tail); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
798 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
799 else if (VECTORP (val)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
800 XVECTOR (val)->contents[toindex++] = elt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
801 else |
211 | 802 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
803 CHECK_NUMBER (elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
804 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
|
805 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
806 if (some_multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
807 toindex_byte |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
808 += CHAR_STRING (XINT (elt), |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
809 SDATA (val) + toindex_byte); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
810 else |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
811 SSET (val, toindex_byte++, XINT (elt)); |
22696
56847e28cc45
(concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22165
diff
changeset
|
812 if (some_multibyte |
56847e28cc45
(concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents:
22165
diff
changeset
|
813 && toindex_byte > 0 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
814 && count_combining (SDATA (val), |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
815 toindex_byte, toindex_byte - 1)) |
46374
5d419e7c527d
* fns.c (concat): Use STRING_SET_CHARS.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
816 STRING_SET_CHARS (val, SCHARS (val) - 1); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
817 else |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
818 toindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
819 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
820 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
821 /* 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
|
822 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
|
823 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
824 int c = XINT (elt); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
825 /* P exists as a variable |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
826 to avoid a bug on the Masscomp C compiler. */ |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
827 unsigned char *p = SDATA (val) + toindex_byte; |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
828 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
829 toindex_byte += CHAR_STRING (c, p); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
830 toindex++; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
831 } |
211 | 832 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
833 } |
211 | 834 } |
485 | 835 if (!NILP (prev)) |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
836 XSETCDR (prev, last_tail); |
211 | 837 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
838 if (num_textprops > 0) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
839 { |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
840 Lisp_Object props; |
35352
42b56dd8986e
(concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents:
35336
diff
changeset
|
841 int last_to_end = -1; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
842 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
843 for (argnum = 0; argnum < num_textprops; argnum++) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
844 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
845 this = args[textprops[argnum].argnum]; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
846 props = text_property_list (this, |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
847 make_number (0), |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
848 make_number (SCHARS (this)), |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
849 Qnil); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
850 /* If successive arguments have properites, be sure that the |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
851 value of `composition' property be the copy. */ |
35352
42b56dd8986e
(concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents:
35336
diff
changeset
|
852 if (last_to_end == textprops[argnum].to) |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
853 make_composition_value_copy (props); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
854 add_text_properties_from_list (val, props, |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
855 make_number (textprops[argnum].to)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
856 last_to_end = textprops[argnum].to + SCHARS (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
857 } |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
858 } |
20004 | 859 return val; |
211 | 860 } |
861 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
862 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
|
863 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
|
864 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
|
865 |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
866 void |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
867 clear_string_char_byte_cache () |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
868 { |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
869 string_char_byte_cache_string = Qnil; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
870 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
871 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
872 /* 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
|
873 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
874 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
875 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
|
876 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
877 int char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
878 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
879 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
880 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
|
881 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
|
882 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
883 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
884 return char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
885 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
886 best_below = best_below_byte = 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
887 best_above = SCHARS (string); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
888 best_above_byte = SBYTES (string); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
889 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
890 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
|
891 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
892 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
|
893 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
894 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
|
895 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
|
896 } |
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 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
|
900 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
|
901 } |
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 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
904 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
|
905 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
906 while (best_below < char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
907 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
908 int c; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
909 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
910 best_below, best_below_byte); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
911 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
912 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
913 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
|
914 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
915 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
916 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
917 while (best_above > char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
918 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
919 unsigned char *pend = SDATA (string) + best_above_byte; |
25501
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
920 unsigned char *pbeg = pend - best_above_byte; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
921 unsigned char *p = pend - 1; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
922 int bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
923 |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
924 while (p > pbeg && !CHAR_HEAD_P (*p)) p--; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
925 PARSE_MULTIBYTE_SEQ (p, pend - p, bytes); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
926 if (bytes == pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
927 best_above_byte -= bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
928 else if (bytes > pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
929 best_above_byte -= (pend - p); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
930 else |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
931 best_above_byte--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
932 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
933 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
934 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
935 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
936 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
937 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
938 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
|
939 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
|
940 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
|
941 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
942 return i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
943 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
944 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
945 /* 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
|
946 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
947 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
948 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
|
949 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
950 int byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
951 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
952 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
953 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
|
954 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
|
955 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
956 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
957 return byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
958 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
959 best_below = best_below_byte = 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
960 best_above = SCHARS (string); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
961 best_above_byte = SBYTES (string); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
962 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
963 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
|
964 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
965 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
|
966 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
967 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
|
968 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
|
969 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
970 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
971 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
972 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
|
973 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
|
974 } |
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 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
977 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
|
978 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
979 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
|
980 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
981 int c; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
982 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
983 best_below, best_below_byte); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
984 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
985 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
986 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
|
987 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
988 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
989 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
990 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
|
991 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
992 unsigned char *pend = SDATA (string) + best_above_byte; |
25501
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
993 unsigned char *pbeg = pend - best_above_byte; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
994 unsigned char *p = pend - 1; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
995 int bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
996 |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
997 while (p > pbeg && !CHAR_HEAD_P (*p)) p--; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
998 PARSE_MULTIBYTE_SEQ (p, pend - p, bytes); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
999 if (bytes == pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
1000 best_above_byte -= bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
1001 else if (bytes > pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
1002 best_above_byte -= (pend - p); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
1003 else |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1004 best_above_byte--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1005 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1006 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1007 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1008 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1009 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1010 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1011 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
|
1012 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
|
1013 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
|
1014 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1015 return i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1016 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1017 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1018 /* Convert STRING to a multibyte string. |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
1019 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
|
1020 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
|
1021 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1022 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1023 string_make_multibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1024 Lisp_Object 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 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1027 int nbytes; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1028 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1029 if (STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1030 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1031 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1032 nbytes = count_size_as_multibyte (SDATA (string), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1033 SCHARS (string)); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1034 /* 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
|
1035 once converted. In that case, we can return STRING itself. */ |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1036 if (nbytes == SBYTES (string)) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1037 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1038 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1039 buf = (unsigned char *) alloca (nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1040 copy_text (SDATA (string), buf, SBYTES (string), |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1041 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1042 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1043 return make_multibyte_string (buf, SCHARS (string), nbytes); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1044 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1045 |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1046 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1047 /* Convert STRING to a multibyte string without changing each |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1048 character codes. Thus, characters 0200 trough 0237 are converted |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1049 to eight-bit-control characters, and characters 0240 through 0377 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1050 are converted eight-bit-graphic characters. */ |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1051 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1052 Lisp_Object |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1053 string_to_multibyte (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1054 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1055 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1056 unsigned char *buf; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1057 int nbytes; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1058 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1059 if (STRING_MULTIBYTE (string)) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1060 return string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1061 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1062 nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string)); |
49815
2a19e12053a4
(string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents:
49798
diff
changeset
|
1063 /* If all the chars are ASCII or eight-bit-graphic, they won't need |
2a19e12053a4
(string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents:
49798
diff
changeset
|
1064 any more bytes once converted. */ |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1065 if (nbytes == SBYTES (string)) |
49815
2a19e12053a4
(string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents:
49798
diff
changeset
|
1066 return make_multibyte_string (SDATA (string), nbytes, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1067 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1068 buf = (unsigned char *) alloca (nbytes); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1069 bcopy (SDATA (string), buf, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1070 str_to_multibyte (buf, nbytes, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1071 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1072 return make_multibyte_string (buf, SCHARS (string), nbytes); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1073 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1074 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1075 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1076 /* 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
|
1077 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1078 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1079 string_make_unibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1080 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1081 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1082 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1083 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1084 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1085 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1086 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1087 buf = (unsigned char *) alloca (SCHARS (string)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1088 |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1089 copy_text (SDATA (string), buf, SBYTES (string), |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1090 1, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1091 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1092 return make_unibyte_string (buf, SCHARS (string)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1093 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1094 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1095 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
|
1096 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1097 doc: /* Return the multibyte equivalent of STRING. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1098 The function `unibyte-char-to-multibyte' is used to convert |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1099 each unibyte character to a multibyte character. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1100 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1101 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1102 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1103 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1104 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1105 return string_make_multibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1106 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1107 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1108 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
|
1109 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1110 doc: /* Return the unibyte equivalent of STRING. |
45650
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1111 Multibyte character codes are converted to unibyte according to |
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1112 `nonascii-translation-table' or, if that is nil, `nonascii-insert-offset'. |
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1113 If the lookup in the translation table fails, this function takes just |
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1114 the low 8 bits of each character. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1115 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1116 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1117 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1118 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1119 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1120 return string_make_unibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1121 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1122 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1123 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
|
1124 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1125 doc: /* Return a unibyte string with the same individual bytes as STRING. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1126 If STRING is unibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1127 Otherwise it is a newly created string, with no text properties. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1128 If STRING is multibyte and contains a character of charset |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1129 `eight-bit-control' or `eight-bit-graphic', it is converted to the |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1130 corresponding single byte. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1131 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1132 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
|
1133 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1134 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1135 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1136 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
|
1137 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1138 int bytes = SBYTES (string); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1139 unsigned char *str = (unsigned char *) xmalloc (bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1140 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1141 bcopy (SDATA (string), str, bytes); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1142 bytes = str_as_unibyte (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1143 string = make_unibyte_string (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1144 xfree (str); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1145 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1146 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1147 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1148 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1149 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
|
1150 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1151 doc: /* Return a multibyte string with the same individual bytes as STRING. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1152 If STRING is multibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1153 Otherwise it is a newly created string, with no text properties. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1154 If STRING is unibyte and contains an individual 8-bit byte (i.e. not |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1155 part of a multibyte form), it is converted to the corresponding |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1156 multibyte character of charset `eight-bit-control' or `eight-bit-graphic'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1157 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1158 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
|
1159 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1160 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1161 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1162 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
|
1163 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1164 Lisp_Object new_string; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1165 int nchars, nbytes; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1166 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1167 parse_str_as_multibyte (SDATA (string), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1168 SBYTES (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1169 &nchars, &nbytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1170 new_string = make_uninit_multibyte_string (nchars, nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1171 bcopy (SDATA (string), SDATA (new_string), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1172 SBYTES (string)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1173 if (nbytes != SBYTES (string)) |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1174 str_as_multibyte (SDATA (new_string), nbytes, |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1175 SBYTES (string), NULL); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1176 string = new_string; |
46379
18cf1d2514d9
* fns.c (Fstring_as_multibyte): Use STRING_SET_INTERVALS.
Ken Raeburn <raeburn@raeburn.org>
parents:
46374
diff
changeset
|
1177 STRING_SET_INTERVALS (string, 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
|
1178 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1179 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1180 } |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1181 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1182 DEFUN ("string-to-multibyte", Fstring_to_multibyte, Sstring_to_multibyte, |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1183 1, 1, 0, |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1184 doc: /* Return a multibyte string with the same individual chars as STRING. |
49674
d7f7ccbc302a
(Fstring_to_multibyte): Fix typo in the docstring.
Kenichi Handa <handa@m17n.org>
parents:
49656
diff
changeset
|
1185 If STRING is multibyte, the result is STRING itself. |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1186 Otherwise it is a newly created string, with no text properties. |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1187 Characters 0200 through 0237 are converted to eight-bit-control |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1188 characters of the same character code. Characters 0240 through 0377 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1189 are converted to eight-bit-control characters of the same character |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1190 codes. */) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1191 (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1192 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1193 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1194 CHECK_STRING (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1195 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1196 return string_to_multibyte (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1197 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1198 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1199 |
211 | 1200 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1201 doc: /* Return a copy of ALIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1202 This is an alist which represents the same mapping from objects to objects, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1203 but does not share the alist structure with ALIST. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1204 The objects mapped (cars and cdrs of elements of the alist) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1205 are shared, however. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1206 Elements of ALIST that are not conses are also shared. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1207 (alist) |
211 | 1208 Lisp_Object alist; |
1209 { | |
1210 register Lisp_Object tem; | |
1211 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1212 CHECK_LIST (alist); |
485 | 1213 if (NILP (alist)) |
211 | 1214 return alist; |
1215 alist = concat (1, &alist, Lisp_Cons, 0); | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1216 for (tem = alist; CONSP (tem); tem = XCDR (tem)) |
211 | 1217 { |
1218 register Lisp_Object car; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1219 car = XCAR (tem); |
211 | 1220 |
1221 if (CONSP (car)) | |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
1222 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); |
211 | 1223 } |
1224 return alist; | |
1225 } | |
1226 | |
1227 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, | |
41006 | 1228 doc: /* Return a substring of STRING, starting at index FROM and ending before TO. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1229 TO may be nil or omitted; then the substring runs to the end of STRING. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1230 FROM and TO start at 0. If either is negative, it counts from the end. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1231 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1232 This function allows vectors as well as strings. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1233 (string, from, to) |
211 | 1234 Lisp_Object string; |
1235 register Lisp_Object from, to; | |
1236 { | |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1237 Lisp_Object res; |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1238 int size; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1239 int size_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1240 int from_char, to_char; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1241 int from_byte = 0, to_byte = 0; |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1242 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1243 if (! (STRINGP (string) || VECTORP (string))) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1244 wrong_type_argument (Qarrayp, string); |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1245 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1246 CHECK_NUMBER (from); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1247 |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1248 if (STRINGP (string)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1249 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1250 size = SCHARS (string); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1251 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1252 } |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1253 else |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1254 size = XVECTOR (string)->size; |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1255 |
485 | 1256 if (NILP (to)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1257 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1258 to_char = size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1259 to_byte = size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1260 } |
211 | 1261 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1262 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1263 CHECK_NUMBER (to); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1264 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1265 to_char = XINT (to); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1266 if (to_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1267 to_char += size; |
211 | 1268 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1269 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1270 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
|
1271 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1272 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1273 from_char = XINT (from); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1274 if (from_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1275 from_char += size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1276 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1277 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
|
1278 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1279 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
|
1280 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
|
1281 make_number (to_char)); |
211 | 1282 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1283 if (STRINGP (string)) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1284 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1285 res = make_specified_string (SDATA (string) + from_byte, |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1286 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
|
1287 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1288 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
|
1289 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
|
1290 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1291 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1292 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
|
1293 XVECTOR (string)->contents + from_char); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1294 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1295 return res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1296 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1297 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1298 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1299 DEFUN ("substring-no-properties", Fsubstring_no_properties, Ssubstring_no_properties, 1, 3, 0, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1300 doc: /* Return a substring of STRING, without text properties. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1301 It starts at index FROM and ending before TO. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1302 TO may be nil or omitted; then the substring runs to the end of STRING. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1303 If FROM is nil or omitted, the substring starts at the beginning of STRING. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1304 If FROM or TO is negative, it counts from the end. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1305 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1306 With one argument, just copy STRING without its properties. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1307 (string, from, to) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1308 Lisp_Object string; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1309 register Lisp_Object from, to; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1310 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1311 int size, size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1312 int from_char, to_char; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1313 int from_byte, to_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1314 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1315 CHECK_STRING (string); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1316 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1317 size = SCHARS (string); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1318 size_byte = SBYTES (string); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1319 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1320 if (NILP (from)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1321 from_char = from_byte = 0; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1322 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1323 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1324 CHECK_NUMBER (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1325 from_char = XINT (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1326 if (from_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1327 from_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1328 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1329 from_byte = string_char_to_byte (string, from_char); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1330 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1331 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1332 if (NILP (to)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1333 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1334 to_char = size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1335 to_byte = size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1336 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1337 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1338 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1339 CHECK_NUMBER (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1340 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1341 to_char = XINT (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1342 if (to_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1343 to_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1344 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1345 to_byte = string_char_to_byte (string, to_char); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1346 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1347 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1348 if (!(0 <= from_char && from_char <= to_char && to_char <= size)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1349 args_out_of_range_3 (string, make_number (from_char), |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1350 make_number (to_char)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1351 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1352 return make_specified_string (SDATA (string) + from_byte, |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1353 to_char - from_char, to_byte - from_byte, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1354 STRING_MULTIBYTE (string)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1355 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1356 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1357 /* 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
|
1358 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
|
1359 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1360 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1361 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
|
1362 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1363 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
|
1364 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1365 Lisp_Object res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1366 int size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1367 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1368 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1369 if (! (STRINGP (string) || VECTORP (string))) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1370 wrong_type_argument (Qarrayp, string); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1371 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1372 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1373 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1374 size = SCHARS (string); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1375 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1376 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1377 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1378 size = XVECTOR (string)->size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1379 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1380 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
|
1381 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
|
1382 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1383 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1384 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1385 res = make_specified_string (SDATA (string) + from_byte, |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1386 to - from, to_byte - from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1387 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1388 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
|
1389 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
|
1390 } |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1391 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1392 res = Fvector (to - from, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1393 XVECTOR (string)->contents + from); |
20004 | 1394 |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1395 return res; |
211 | 1396 } |
1397 | |
1398 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1399 doc: /* Take cdr N times on LIST, returns the result. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1400 (n, list) |
211 | 1401 Lisp_Object n; |
1402 register Lisp_Object list; | |
1403 { | |
1404 register int i, num; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1405 CHECK_NUMBER (n); |
211 | 1406 num = XINT (n); |
485 | 1407 for (i = 0; i < num && !NILP (list); i++) |
211 | 1408 { |
1409 QUIT; | |
26596 | 1410 if (! CONSP (list)) |
1411 wrong_type_argument (Qlistp, list); | |
1412 list = XCDR (list); | |
211 | 1413 } |
1414 return list; | |
1415 } | |
1416 | |
1417 DEFUN ("nth", Fnth, Snth, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1418 doc: /* Return the Nth element of LIST. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1419 N counts from zero. If LIST is not that long, nil is returned. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1420 (n, list) |
211 | 1421 Lisp_Object n, list; |
1422 { | |
1423 return Fcar (Fnthcdr (n, list)); | |
1424 } | |
1425 | |
1426 DEFUN ("elt", Felt, Selt, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1427 doc: /* Return element of SEQUENCE at index N. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1428 (sequence, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1429 register Lisp_Object sequence, n; |
211 | 1430 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1431 CHECK_NUMBER (n); |
211 | 1432 while (1) |
1433 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1434 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
|
1435 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
|
1436 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
|
1437 || 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
|
1438 return Faref (sequence, n); |
211 | 1439 else |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1440 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 1441 } |
1442 } | |
1443 | |
1444 DEFUN ("member", Fmember, Smember, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1445 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1446 The value is actually the tail of LIST whose car is ELT. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1447 (elt, list) |
211 | 1448 register Lisp_Object elt; |
1449 Lisp_Object list; | |
1450 { | |
1451 register Lisp_Object tail; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1452 for (tail = list; !NILP (tail); tail = XCDR (tail)) |
211 | 1453 { |
1454 register Lisp_Object tem; | |
26596 | 1455 if (! CONSP (tail)) |
1456 wrong_type_argument (Qlistp, list); | |
1457 tem = XCAR (tail); | |
485 | 1458 if (! NILP (Fequal (elt, tem))) |
211 | 1459 return tail; |
1460 QUIT; | |
1461 } | |
1462 return Qnil; | |
1463 } | |
1464 | |
1465 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1466 doc: /* Return non-nil if ELT is an element of LIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1467 Comparison done with EQ. The value is actually the tail of LIST |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1468 whose car is ELT. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1469 (elt, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1470 Lisp_Object elt, list; |
211 | 1471 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1472 while (1) |
211 | 1473 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1474 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1475 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1476 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1477 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1478 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1479 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1480 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1481 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1482 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1483 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1484 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1485 list = XCDR (list); |
211 | 1486 QUIT; |
1487 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1488 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1489 if (!CONSP (list) && !NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1490 list = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1491 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1492 return list; |
211 | 1493 } |
1494 | |
1495 DEFUN ("assq", Fassq, Sassq, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1496 doc: /* Return non-nil if KEY is `eq' to the car of an element of LIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1497 The value is actually the element of LIST whose car is KEY. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1498 Elements of LIST that are not conses are ignored. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1499 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1500 Lisp_Object key, list; |
211 | 1501 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1502 Lisp_Object result; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1503 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1504 while (1) |
211 | 1505 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1506 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1507 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1508 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1509 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1510 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1511 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1512 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1513 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1514 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1515 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1516 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1517 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1518 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1519 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1520 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1521 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1522 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1523 list = XCDR (list); |
211 | 1524 QUIT; |
1525 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1526 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1527 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1528 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1529 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1530 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1531 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1532 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1533 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1534 return result; |
211 | 1535 } |
1536 | |
1537 /* Like Fassq but never report an error and do not allow quits. | |
1538 Use only on lists known never to be circular. */ | |
1539 | |
1540 Lisp_Object | |
1541 assq_no_quit (key, list) | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1542 Lisp_Object key, list; |
211 | 1543 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1544 while (CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1545 && (!CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1546 || !EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1547 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1548 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1549 return CONSP (list) ? XCAR (list) : Qnil; |
211 | 1550 } |
1551 | |
1552 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1553 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1554 The value is actually the element of LIST whose car equals KEY. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1555 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1556 Lisp_Object key, list; |
211 | 1557 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1558 Lisp_Object result, car; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1559 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1560 while (1) |
211 | 1561 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1562 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1563 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1564 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1565 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1566 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1567 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1568 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1569 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1570 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1571 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1572 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1573 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1574 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1575 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1576 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1577 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1578 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1579 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1580 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1581 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1582 list = XCDR (list); |
211 | 1583 QUIT; |
1584 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1585 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1586 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1587 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1588 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1589 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1590 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1591 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1592 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1593 return result; |
211 | 1594 } |
1595 | |
1596 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1597 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1598 The value is actually the element of LIST whose cdr is KEY. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1599 (key, list) |
211 | 1600 register Lisp_Object key; |
1601 Lisp_Object list; | |
1602 { | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1603 Lisp_Object result; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1604 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1605 while (1) |
211 | 1606 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1607 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1608 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1609 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1610 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1611 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1612 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1613 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1614 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1615 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1616 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1617 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1618 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1619 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1620 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1621 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1622 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1623 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1624 list = XCDR (list); |
211 | 1625 QUIT; |
1626 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1627 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1628 if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1629 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1630 else if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1631 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1632 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1633 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1634 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1635 return result; |
211 | 1636 } |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1637 |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1638 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1639 doc: /* Return non-nil if KEY is `equal' to the cdr of an element of LIST. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1640 The value is actually the element of LIST whose cdr equals KEY. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1641 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1642 Lisp_Object key, list; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1643 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1644 Lisp_Object result, cdr; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1645 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1646 while (1) |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1647 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1648 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1649 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1650 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1651 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1652 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1653 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1654 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1655 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1656 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1657 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1658 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1659 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1660 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1661 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1662 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1663 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1664 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1665 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1666 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1667 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1668 list = XCDR (list); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1669 QUIT; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1670 } |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1671 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1672 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1673 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1674 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1675 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1676 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1677 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1678 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1679 return result; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1680 } |
211 | 1681 |
1682 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1683 doc: /* Delete by side effect any occurrences of ELT as a member of LIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1684 The modified LIST is returned. Comparison is done with `eq'. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1685 If the first member of LIST is ELT, there is no way to remove it by side effect; |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1686 therefore, write `(setq foo (delq element foo))' |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1687 to be sure of changing the value of `foo'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1688 (elt, list) |
211 | 1689 register Lisp_Object elt; |
1690 Lisp_Object list; | |
1691 { | |
1692 register Lisp_Object tail, prev; | |
1693 register Lisp_Object tem; | |
1694 | |
1695 tail = list; | |
1696 prev = Qnil; | |
485 | 1697 while (!NILP (tail)) |
211 | 1698 { |
26596 | 1699 if (! CONSP (tail)) |
1700 wrong_type_argument (Qlistp, list); | |
1701 tem = XCAR (tail); | |
211 | 1702 if (EQ (elt, tem)) |
1703 { | |
485 | 1704 if (NILP (prev)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1705 list = XCDR (tail); |
211 | 1706 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1707 Fsetcdr (prev, XCDR (tail)); |
211 | 1708 } |
1709 else | |
1710 prev = tail; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1711 tail = XCDR (tail); |
211 | 1712 QUIT; |
1713 } | |
1714 return list; | |
1715 } | |
1716 | |
414 | 1717 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1718 doc: /* Delete by side effect any occurrences of ELT as a member of SEQ. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1719 SEQ must be a list, a vector, or a string. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1720 The modified SEQ is returned. Comparison is done with `equal'. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1721 If SEQ is not a list, or the first member of SEQ is ELT, deleting it |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1722 is not a side effect; it is simply using a different sequence. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1723 Therefore, write `(setq foo (delete element foo))' |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1724 to be sure of changing the value of `foo'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1725 (elt, seq) |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1726 Lisp_Object elt, seq; |
401 | 1727 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1728 if (VECTORP (seq)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1729 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
1730 EMACS_INT i, n; |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1731 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1732 for (i = n = 0; i < ASIZE (seq); ++i) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1733 if (NILP (Fequal (AREF (seq, i), elt))) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1734 ++n; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1735 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1736 if (n != ASIZE (seq)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1737 { |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
1738 struct Lisp_Vector *p = allocate_vector (n); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1739 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1740 for (i = n = 0; i < ASIZE (seq); ++i) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1741 if (NILP (Fequal (AREF (seq, i), elt))) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1742 p->contents[n++] = AREF (seq, i); |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1743 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1744 XSETVECTOR (seq, p); |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1745 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1746 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1747 else if (STRINGP (seq)) |
401 | 1748 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1749 EMACS_INT i, ibyte, nchars, nbytes, cbytes; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1750 int c; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1751 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1752 for (i = nchars = nbytes = ibyte = 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1753 i < SCHARS (seq); |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1754 ++i, ibyte += cbytes) |
401 | 1755 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1756 if (STRING_MULTIBYTE (seq)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1757 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1758 c = STRING_CHAR (SDATA (seq) + ibyte, |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1759 SBYTES (seq) - ibyte); |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1760 cbytes = CHAR_BYTES (c); |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1761 } |
401 | 1762 else |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1763 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1764 c = SREF (seq, i); |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1765 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1766 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1767 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1768 if (!INTEGERP (elt) || c != XINT (elt)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1769 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1770 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1771 nbytes += cbytes; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1772 } |
401 | 1773 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1774 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1775 if (nchars != SCHARS (seq)) |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1776 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1777 Lisp_Object tem; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1778 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1779 tem = make_uninit_multibyte_string (nchars, nbytes); |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1780 if (!STRING_MULTIBYTE (seq)) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1781 STRING_SET_UNIBYTE (tem); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1782 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1783 for (i = nchars = nbytes = ibyte = 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1784 i < SCHARS (seq); |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1785 ++i, ibyte += cbytes) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1786 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1787 if (STRING_MULTIBYTE (seq)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1788 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1789 c = STRING_CHAR (SDATA (seq) + ibyte, |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1790 SBYTES (seq) - ibyte); |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1791 cbytes = CHAR_BYTES (c); |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1792 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1793 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1794 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1795 c = SREF (seq, i); |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1796 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1797 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1798 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1799 if (!INTEGERP (elt) || c != XINT (elt)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1800 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1801 unsigned char *from = SDATA (seq) + ibyte; |
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1802 unsigned char *to = SDATA (tem) + nbytes; |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1803 EMACS_INT n; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1804 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1805 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1806 nbytes += cbytes; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1807 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1808 for (n = cbytes; n--; ) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1809 *to++ = *from++; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1810 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1811 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1812 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1813 seq = tem; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1814 } |
401 | 1815 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1816 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1817 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1818 Lisp_Object tail, prev; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1819 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1820 for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1821 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1822 if (!CONSP (tail)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1823 wrong_type_argument (Qlistp, seq); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1824 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1825 if (!NILP (Fequal (elt, XCAR (tail)))) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1826 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1827 if (NILP (prev)) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1828 seq = XCDR (tail); |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1829 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1830 Fsetcdr (prev, XCDR (tail)); |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1831 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1832 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1833 prev = tail; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1834 QUIT; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1835 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1836 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1837 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1838 return seq; |
401 | 1839 } |
1840 | |
211 | 1841 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1842 doc: /* Reverse LIST by modifying cdr pointers. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1843 Returns the beginning of the reversed list. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1844 (list) |
211 | 1845 Lisp_Object list; |
1846 { | |
1847 register Lisp_Object prev, tail, next; | |
1848 | |
485 | 1849 if (NILP (list)) return list; |
211 | 1850 prev = Qnil; |
1851 tail = list; | |
485 | 1852 while (!NILP (tail)) |
211 | 1853 { |
1854 QUIT; | |
26596 | 1855 if (! CONSP (tail)) |
1856 wrong_type_argument (Qlistp, list); | |
1857 next = XCDR (tail); | |
211 | 1858 Fsetcdr (tail, prev); |
1859 prev = tail; | |
1860 tail = next; | |
1861 } | |
1862 return prev; | |
1863 } | |
1864 | |
1865 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, | |
40985 | 1866 doc: /* Reverse LIST, copying. Returns the beginning of the reversed list. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1867 See also the function `nreverse', which is used more often. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1868 (list) |
211 | 1869 Lisp_Object list; |
1870 { | |
18421 | 1871 Lisp_Object new; |
211 | 1872 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1873 for (new = Qnil; CONSP (list); list = XCDR (list)) |
49204 | 1874 { |
1875 QUIT; | |
1876 new = Fcons (XCAR (list), new); | |
1877 } | |
18421 | 1878 if (!NILP (list)) |
1879 wrong_type_argument (Qconsp, list); | |
1880 return new; | |
211 | 1881 } |
1882 | |
1883 Lisp_Object merge (); | |
1884 | |
1885 DEFUN ("sort", Fsort, Ssort, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1886 doc: /* Sort LIST, stably, comparing elements using PREDICATE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1887 Returns the sorted list. LIST is modified by side effects. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1888 PREDICATE is called with two elements of LIST, and should return t |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1889 if the first element is "less" than the second. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1890 (list, predicate) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1891 Lisp_Object list, predicate; |
211 | 1892 { |
1893 Lisp_Object front, back; | |
1894 register Lisp_Object len, tem; | |
1895 struct gcpro gcpro1, gcpro2; | |
1896 register int length; | |
1897 | |
1898 front = list; | |
1899 len = Flength (list); | |
1900 length = XINT (len); | |
1901 if (length < 2) | |
1902 return list; | |
1903 | |
1904 XSETINT (len, (length / 2) - 1); | |
1905 tem = Fnthcdr (len, list); | |
1906 back = Fcdr (tem); | |
1907 Fsetcdr (tem, Qnil); | |
1908 | |
1909 GCPRO2 (front, back); | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1910 front = Fsort (front, predicate); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1911 back = Fsort (back, predicate); |
211 | 1912 UNGCPRO; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1913 return merge (front, back, predicate); |
211 | 1914 } |
1915 | |
1916 Lisp_Object | |
1917 merge (org_l1, org_l2, pred) | |
1918 Lisp_Object org_l1, org_l2; | |
1919 Lisp_Object pred; | |
1920 { | |
1921 Lisp_Object value; | |
1922 register Lisp_Object tail; | |
1923 Lisp_Object tem; | |
1924 register Lisp_Object l1, l2; | |
1925 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1926 | |
1927 l1 = org_l1; | |
1928 l2 = org_l2; | |
1929 tail = Qnil; | |
1930 value = Qnil; | |
1931 | |
1932 /* It is sufficient to protect org_l1 and org_l2. | |
1933 When l1 and l2 are updated, we copy the new values | |
1934 back into the org_ vars. */ | |
1935 GCPRO4 (org_l1, org_l2, pred, value); | |
1936 | |
1937 while (1) | |
1938 { | |
485 | 1939 if (NILP (l1)) |
211 | 1940 { |
1941 UNGCPRO; | |
485 | 1942 if (NILP (tail)) |
211 | 1943 return l2; |
1944 Fsetcdr (tail, l2); | |
1945 return value; | |
1946 } | |
485 | 1947 if (NILP (l2)) |
211 | 1948 { |
1949 UNGCPRO; | |
485 | 1950 if (NILP (tail)) |
211 | 1951 return l1; |
1952 Fsetcdr (tail, l1); | |
1953 return value; | |
1954 } | |
1955 tem = call2 (pred, Fcar (l2), Fcar (l1)); | |
485 | 1956 if (NILP (tem)) |
211 | 1957 { |
1958 tem = l1; | |
1959 l1 = Fcdr (l1); | |
1960 org_l1 = l1; | |
1961 } | |
1962 else | |
1963 { | |
1964 tem = l2; | |
1965 l2 = Fcdr (l2); | |
1966 org_l2 = l2; | |
1967 } | |
485 | 1968 if (NILP (tail)) |
211 | 1969 value = tem; |
1970 else | |
1971 Fsetcdr (tail, tem); | |
1972 tail = tem; | |
1973 } | |
1974 } | |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1975 |
211 | 1976 |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1977 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1978 doc: /* Extract a value from a property list. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1979 PLIST is a property list, which is a list of the form |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1980 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1981 corresponding to the given PROP, or nil if PROP is not |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1982 one of the properties on the list. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1983 (plist, prop) |
14051
7f7e97f219ce
(Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents:
13862
diff
changeset
|
1984 Lisp_Object plist; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1985 Lisp_Object prop; |
211 | 1986 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1987 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1988 |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1989 for (tail = plist; |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1990 CONSP (tail) && CONSP (XCDR (tail)); |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1991 tail = XCDR (XCDR (tail))) |
211 | 1992 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1993 if (EQ (prop, XCAR (tail))) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1994 return XCAR (XCDR (tail)); |
37317
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1995 |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1996 /* This function can be called asynchronously |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1997 (setup_coding_system). Don't QUIT in that case. */ |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1998 if (!interrupt_input_blocked) |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1999 QUIT; |
211 | 2000 } |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2001 |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2002 if (!NILP (tail)) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2003 wrong_type_argument (Qlistp, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2004 |
211 | 2005 return Qnil; |
2006 } | |
2007 | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2008 DEFUN ("get", Fget, Sget, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2009 doc: /* Return the value of SYMBOL's PROPNAME property. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2010 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2011 (symbol, propname) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2012 Lisp_Object symbol, propname; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2013 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2014 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2015 return Fplist_get (XSYMBOL (symbol)->plist, propname); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2016 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2017 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2018 DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2019 doc: /* Change value in PLIST of PROP to VAL. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2020 PLIST is a property list, which is a list of the form |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2021 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2022 If PROP is already a property on the list, its value is set to VAL, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2023 otherwise the new PROP VAL pair is added. The new plist is returned; |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2024 use `(setq x (plist-put x prop val))' to be sure to use the new value. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2025 The PLIST is modified by side effects. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2026 (plist, prop, val) |
20004 | 2027 Lisp_Object plist; |
2028 register Lisp_Object prop; | |
2029 Lisp_Object val; | |
211 | 2030 { |
2031 register Lisp_Object tail, prev; | |
2032 Lisp_Object newcell; | |
2033 prev = Qnil; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2034 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2035 tail = XCDR (XCDR (tail))) |
211 | 2036 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2037 if (EQ (prop, XCAR (tail))) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2038 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2039 Fsetcar (XCDR (tail), val); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2040 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2041 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2042 |
211 | 2043 prev = tail; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2044 QUIT; |
211 | 2045 } |
2046 newcell = Fcons (prop, Fcons (val, Qnil)); | |
485 | 2047 if (NILP (prev)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2048 return newcell; |
211 | 2049 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2050 Fsetcdr (XCDR (prev), newcell); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2051 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2052 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2053 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2054 DEFUN ("put", Fput, Sput, 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2055 doc: /* Store SYMBOL's PROPNAME property with value VALUE. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2056 It can be retrieved with `(get SYMBOL PROPNAME)'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2057 (symbol, propname, value) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2058 Lisp_Object symbol, propname, value; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2059 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2060 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2061 XSYMBOL (symbol)->plist |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2062 = 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
|
2063 return value; |
211 | 2064 } |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2065 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2066 DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2067 doc: /* Extract a value from a property list, comparing with `equal'. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2068 PLIST is a property list, which is a list of the form |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2069 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2070 corresponding to the given PROP, or nil if PROP is not |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2071 one of the properties on the list. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2072 (plist, prop) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2073 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2074 Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2075 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2076 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2077 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2078 for (tail = plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2079 CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2080 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2081 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2082 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2083 return XCAR (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2084 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2085 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2086 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2087 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2088 if (!NILP (tail)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2089 wrong_type_argument (Qlistp, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2090 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2091 return Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2092 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2093 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2094 DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2095 doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2096 PLIST is a property list, which is a list of the form |
44219 | 2097 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects. |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2098 If PROP is already a property on the list, its value is set to VAL, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2099 otherwise the new PROP VAL pair is added. The new plist is returned; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2100 use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2101 The PLIST is modified by side effects. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2102 (plist, prop, val) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2103 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2104 register Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2105 Lisp_Object val; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2106 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2107 register Lisp_Object tail, prev; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2108 Lisp_Object newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2109 prev = Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2110 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2111 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2112 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2113 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2114 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2115 Fsetcar (XCDR (tail), val); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2116 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2117 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2118 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2119 prev = tail; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2120 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2121 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2122 newcell = Fcons (prop, Fcons (val, Qnil)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2123 if (NILP (prev)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2124 return newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2125 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2126 Fsetcdr (XCDR (prev), newcell); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2127 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2128 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2129 |
211 | 2130 DEFUN ("equal", Fequal, Sequal, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2131 doc: /* Return t if two Lisp objects have similar structure and contents. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2132 They must have the same data type. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2133 Conses are compared by comparing the cars and the cdrs. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2134 Vectors and strings are compared element by element. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2135 Numbers are compared by value, but integers cannot equal floats. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2136 (Use `=' if you want integers and floats to be able to be equal.) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2137 Symbols must match exactly. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2138 (o1, o2) |
211 | 2139 register Lisp_Object o1, o2; |
2140 { | |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2141 return internal_equal (o1, o2, 0) ? Qt : Qnil; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2142 } |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2143 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2144 static int |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2145 internal_equal (o1, o2, depth) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2146 register Lisp_Object o1, o2; |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2147 int depth; |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2148 { |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2149 if (depth > 200) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2150 error ("Stack overflow in equal"); |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2151 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2152 tail_recurse: |
211 | 2153 QUIT; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2154 if (EQ (o1, o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2155 return 1; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2156 if (XTYPE (o1) != XTYPE (o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2157 return 0; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2158 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2159 switch (XTYPE (o1)) |
211 | 2160 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2161 case Lisp_Float: |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2162 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
|
2163 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2164 case Lisp_Cons: |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2165 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2166 return 0; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2167 o1 = XCDR (o1); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2168 o2 = XCDR (o2); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2169 goto tail_recurse; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2170 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2171 case Lisp_Misc: |
11240
2642924d2d21
(internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
2172 if (XMISCTYPE (o1) != XMISCTYPE (o2)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2173 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2174 if (OVERLAYP (o1)) |
211 | 2175 { |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2176 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
|
2177 depth + 1) |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2178 || !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
|
2179 depth + 1)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2180 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2181 o1 = XOVERLAY (o1)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2182 o2 = XOVERLAY (o2)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2183 goto tail_recurse; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2184 } |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2185 if (MARKERP (o1)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2186 { |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2187 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
|
2188 && (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
|
2189 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); |
211 | 2190 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2191 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2192 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2193 case Lisp_Vectorlike: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2194 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2195 register int i, size; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2196 size = XVECTOR (o1)->size; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2197 /* 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
|
2198 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
|
2199 same size. */ |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2200 if (XVECTOR (o2)->size != size) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2201 return 0; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2202 /* Boolvectors are compared much like strings. */ |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2203 if (BOOL_VECTOR_P (o1)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2204 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2205 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
2206 = (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
|
2207 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2208 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
|
2209 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2210 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
|
2211 size_in_chars)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2212 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2213 return 1; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2214 } |
20776
219fdecc30d3
(internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents:
20712
diff
changeset
|
2215 if (WINDOW_CONFIGURATIONP (o1)) |
21021
7be2384fabdc
(internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents:
20992
diff
changeset
|
2216 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
|
2217 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2218 /* 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
|
2219 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
|
2220 if (size & PSEUDOVECTOR_FLAG) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2221 { |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2222 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2223 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2224 size &= PSEUDOVECTOR_SIZE_MASK; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2225 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2226 for (i = 0; i < size; i++) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2227 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2228 Lisp_Object v1, v2; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2229 v1 = XVECTOR (o1)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2230 v2 = XVECTOR (o2)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2231 if (!internal_equal (v1, v2, depth + 1)) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2232 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2233 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2234 return 1; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2235 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2236 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2237 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2238 case Lisp_String: |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2239 if (SCHARS (o1) != SCHARS (o2)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2240 return 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2241 if (SBYTES (o1) != SBYTES (o2)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2242 return 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2243 if (bcmp (SDATA (o1), SDATA (o2), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2244 SBYTES (o1))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2245 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2246 return 1; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2247 |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2248 case Lisp_Int: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2249 case Lisp_Symbol: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2250 case Lisp_Type_Limit: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2251 break; |
211 | 2252 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2253 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2254 return 0; |
211 | 2255 } |
2256 | |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
2257 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
|
2258 |
211 | 2259 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2260 doc: /* Store each element of ARRAY with ITEM. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2261 ARRAY is a vector, string, char-table, or bool-vector. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2262 (array, item) |
211 | 2263 Lisp_Object array, item; |
2264 { | |
2265 register int size, index, charval; | |
2266 retry: | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2267 if (VECTORP (array)) |
211 | 2268 { |
2269 register Lisp_Object *p = XVECTOR (array)->contents; | |
2270 size = XVECTOR (array)->size; | |
2271 for (index = 0; index < size; index++) | |
2272 p[index] = item; | |
2273 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2274 else if (CHAR_TABLE_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2275 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2276 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
|
2277 size = CHAR_TABLE_ORDINARY_SLOTS; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2278 for (index = 0; index < size; index++) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2279 p[index] = item; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2280 XCHAR_TABLE (array)->defalt = Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2281 } |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2282 else if (STRINGP (array)) |
211 | 2283 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2284 register unsigned char *p = SDATA (array); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2285 CHECK_NUMBER (item); |
211 | 2286 charval = XINT (item); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2287 size = SCHARS (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2288 if (STRING_MULTIBYTE (array)) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2289 { |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
2290 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
2291 int len = CHAR_STRING (charval, str); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2292 int size_byte = SBYTES (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2293 unsigned char *p1 = p, *endp = p + size_byte; |
23453
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2294 int i; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2295 |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2296 if (size != size_byte) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2297 while (p1 < endp) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2298 { |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2299 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2300 if (len != this_len) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2301 error ("Attempt to change byte length of a string"); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2302 p1 += this_len; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2303 } |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2304 for (i = 0; i < size_byte; i++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2305 *p++ = str[i % len]; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2306 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2307 else |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2308 for (index = 0; index < size; index++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2309 p[index] = charval; |
211 | 2310 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2311 else if (BOOL_VECTOR_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2312 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2313 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
|
2314 int size_in_chars |
17063
647b28ba4d1b
(Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents:
16863
diff
changeset
|
2315 = (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
|
2316 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2317 charval = (! NILP (item) ? -1 : 0); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2318 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
|
2319 p[index] = charval; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2320 } |
211 | 2321 else |
2322 { | |
2323 array = wrong_type_argument (Qarrayp, array); | |
2324 goto retry; | |
2325 } | |
2326 return array; | |
2327 } | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2328 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2329 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
|
2330 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2331 doc: /* Return the subtype of char-table CHAR-TABLE. The value is a symbol. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2332 (char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2333 Lisp_Object char_table; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2334 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2335 CHECK_CHAR_TABLE (char_table); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2336 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2337 return XCHAR_TABLE (char_table)->purpose; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2338 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2339 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2340 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
|
2341 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2342 doc: /* Return the parent char-table of CHAR-TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2343 The value is either nil or another char-table. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2344 If CHAR-TABLE holds nil for a given character, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2345 then the actual applicable value is inherited from the parent char-table |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2346 \(or from its parents, if necessary). */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2347 (char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2348 Lisp_Object char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2349 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2350 CHECK_CHAR_TABLE (char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2351 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2352 return XCHAR_TABLE (char_table)->parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2353 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2354 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2355 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
|
2356 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2357 doc: /* Set the parent char-table of CHAR-TABLE to PARENT. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2358 PARENT must be either nil or another char-table. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2359 (char_table, parent) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2360 Lisp_Object char_table, parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2361 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2362 Lisp_Object temp; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2363 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2364 CHECK_CHAR_TABLE (char_table); |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2365 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2366 if (!NILP (parent)) |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2367 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2368 CHECK_CHAR_TABLE (parent); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2369 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2370 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
|
2371 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
|
2372 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
|
2373 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2374 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2375 XCHAR_TABLE (char_table)->parent = parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2376 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2377 return parent; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2378 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2379 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2380 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
|
2381 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2382 doc: /* Return the value of CHAR-TABLE's extra-slot number N. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2383 (char_table, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2384 Lisp_Object char_table, n; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2385 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2386 CHECK_CHAR_TABLE (char_table); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2387 CHECK_NUMBER (n); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2388 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
|
2389 || 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
|
2390 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
|
2391 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2392 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
|
2393 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2394 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2395 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
|
2396 Sset_char_table_extra_slot, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2397 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2398 doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2399 (char_table, n, value) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2400 Lisp_Object char_table, n, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2401 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2402 CHECK_CHAR_TABLE (char_table); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2403 CHECK_NUMBER (n); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2404 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
|
2405 || 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
|
2406 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
|
2407 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2408 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
|
2409 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2410 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2411 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
|
2412 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2413 doc: /* Return the value in CHAR-TABLE for a range of characters RANGE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2414 RANGE should be nil (for the default value) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2415 a vector which identifies a character set or a row of a character set, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2416 a character set name, or a character code. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2417 (char_table, range) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2418 Lisp_Object char_table, range; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2419 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2420 CHECK_CHAR_TABLE (char_table); |
20004 | 2421 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2422 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
|
2423 return XCHAR_TABLE (char_table)->defalt; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2424 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
|
2425 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
|
2426 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
|
2427 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2428 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
|
2429 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2430 charset_info = Fget (range, Qcharset); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2431 CHECK_VECTOR (charset_info); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2432 |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2433 return Faref (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2434 make_number (XINT (XVECTOR (charset_info)->contents[0]) |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2435 + 128)); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2436 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2437 else if (VECTORP (range)) |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2438 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2439 if (XVECTOR (range)->size == 1) |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2440 return Faref (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2441 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
|
2442 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2443 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2444 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2445 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2446 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
|
2447 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2448 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2449 return Faref (char_table, ch); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2450 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2451 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2452 else |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2453 error ("Invalid RANGE argument to `char-table-range'"); |
28666 | 2454 return Qt; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2455 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2456 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2457 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
|
2458 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2459 doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2460 RANGE should be t (for all characters), nil (for the default value) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2461 a vector which identifies a character set or a row of a character set, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2462 a coding system, or a character code. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2463 (char_table, range, value) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2464 Lisp_Object char_table, range, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2465 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2466 int i; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2467 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2468 CHECK_CHAR_TABLE (char_table); |
20004 | 2469 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2470 if (EQ (range, Qt)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2471 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
|
2472 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
|
2473 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
|
2474 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
|
2475 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
|
2476 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2477 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
|
2478 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2479 charset_info = Fget (range, Qcharset); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2480 CHECK_VECTOR (charset_info); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2481 |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2482 return Faset (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2483 make_number (XINT (XVECTOR (charset_info)->contents[0]) |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2484 + 128), |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2485 value); |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2486 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2487 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
|
2488 Faset (char_table, range, value); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2489 else if (VECTORP (range)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2490 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2491 if (XVECTOR (range)->size == 1) |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2492 return Faset (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2493 make_number (XINT (XVECTOR (range)->contents[0]) + 128), |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2494 value); |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2495 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2496 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2497 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2498 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2499 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
|
2500 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2501 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2502 return Faset (char_table, ch, value); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2503 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2504 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2505 else |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2506 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
|
2507 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2508 return value; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2509 } |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2510 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2511 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
|
2512 Sset_char_table_default, 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2513 doc: /* Set the default value in CHAR-TABLE for a generic character CHAR to VALUE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2514 The generic character specifies the group of characters. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2515 See also the documentation of make-char. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2516 (char_table, ch, value) |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2517 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
|
2518 { |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
2519 int c, charset, code1, code2; |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2520 Lisp_Object temp; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2521 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2522 CHECK_CHAR_TABLE (char_table); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2523 CHECK_NUMBER (ch); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2524 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2525 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
|
2526 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
|
2527 |
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2528 /* 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
|
2529 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
|
2530 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
|
2531 if (! CHARSET_VALID_P (charset)) |
22706 | 2532 invalid_character (c); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2533 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2534 if (charset == CHARSET_ASCII) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2535 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
|
2536 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2537 /* 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
|
2538 generic char is specified. */ |
38483
eac29e9f6d99
* fns.c (Fset_char_table_default): Check that a charset is defined before checking its dimension.
Ken Raeburn <raeburn@raeburn.org>
parents:
37319
diff
changeset
|
2539 if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1) |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2540 code1 = 0; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2541 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
|
2542 if (!code1) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2543 { |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2544 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
|
2545 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2546 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2547 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
|
2548 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2549 } |
35479
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2550 if (SUB_CHAR_TABLE_P (temp)) |
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2551 char_table = temp; |
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2552 else |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2553 char_table = (XCHAR_TABLE (char_table)->contents[charset + 128] |
35479
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2554 = make_sub_char_table (temp)); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2555 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
|
2556 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
|
2557 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2558 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2559 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
|
2560 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2561 } |
21339
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2562 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2563 /* 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
|
2564 and return it as an integer. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2565 If the element is nil, return CH itself. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2566 (Actually we do that for any non-integer.) */ |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2567 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2568 int |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2569 char_table_translate (table, ch) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2570 Lisp_Object table; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2571 int ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2572 { |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2573 Lisp_Object value; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2574 value = Faref (table, make_number (ch)); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2575 if (! INTEGERP (value)) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2576 return ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2577 return XINT (value); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2578 } |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2579 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2580 static void |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2581 optimize_sub_char_table (table, chars) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2582 Lisp_Object *table; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2583 int chars; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2584 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2585 Lisp_Object elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2586 int from, to; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2587 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2588 if (chars == 94) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2589 from = 33, to = 127; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2590 else |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2591 from = 32, to = 128; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2592 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2593 if (!SUB_CHAR_TABLE_P (*table)) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2594 return; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2595 elt = XCHAR_TABLE (*table)->contents[from++]; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2596 for (; from < to; from++) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2597 if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from]))) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2598 return; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2599 *table = elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2600 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2601 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2602 DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2603 1, 1, 0, doc: /* Optimize char table TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2604 (table) |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2605 Lisp_Object table; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2606 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2607 Lisp_Object elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2608 int dim; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2609 int i, j; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2610 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2611 CHECK_CHAR_TABLE (table); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2612 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2613 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2614 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2615 elt = XCHAR_TABLE (table)->contents[i]; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2616 if (!SUB_CHAR_TABLE_P (elt)) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2617 continue; |
33041
10bc9f620b67
(Foptimize_char_table): Fix arg for CHARSET_DIMENSION.
Kenichi Handa <handa@m17n.org>
parents:
32753
diff
changeset
|
2618 dim = CHARSET_DIMENSION (i - 128); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2619 if (dim == 2) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2620 for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2621 optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim); |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2622 optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, dim); |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2623 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2624 return Qnil; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2625 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2626 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2627 |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2628 /* 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
|
2629 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
|
2630 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
|
2631 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
|
2632 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
|
2633 |
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2634 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
|
2635 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2636 void |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2637 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
|
2638 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
|
2639 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
|
2640 int depth; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2641 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2642 int i, to; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2643 |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2644 if (depth == 0) |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2645 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2646 /* 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
|
2647 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
|
2648 { |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2649 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
|
2650 if (c_function) |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2651 (*c_function) (arg, make_number (i), elt); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2652 else |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2653 call2 (function, make_number (i), elt); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2654 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2655 #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
|
2656 we should report them. */ |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2657 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
|
2658 return; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2659 #endif |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2660 to = CHAR_TABLE_ORDINARY_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2661 } |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2662 else |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2663 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2664 int charset = XFASTINT (indices[0]) - 128; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2665 |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2666 i = 32; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2667 to = SUB_CHAR_TABLE_ORDINARY_SLOTS; |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2668 if (CHARSET_CHARS (charset) == 94) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2669 i++, to--; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2670 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2671 |
18000
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2672 for (; i < to; i++) |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2673 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2674 Lisp_Object elt; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2675 int charset; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2676 |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2677 elt = XCHAR_TABLE (subtable)->contents[i]; |
18108
af791b0f0657
(map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents:
18035
diff
changeset
|
2678 XSETFASTINT (indices[depth], i); |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2679 charset = XFASTINT (indices[0]) - 128; |
29232
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2680 if (depth == 0 |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2681 && (!CHARSET_DEFINED_P (charset) |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2682 || charset == CHARSET_8_BIT_CONTROL |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2683 || charset == CHARSET_8_BIT_GRAPHIC)) |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2684 continue; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2685 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2686 if (SUB_CHAR_TABLE_P (elt)) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2687 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2688 if (depth >= 3) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2689 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
|
2690 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
|
2691 } |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2692 else |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2693 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2694 int c1, c2, c; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2695 |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2696 if (NILP (elt)) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2697 elt = XCHAR_TABLE (subtable)->defalt; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2698 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2699 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
2700 c = MAKE_CHAR (charset, c1, c2); |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2701 if (c_function) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2702 (*c_function) (arg, make_number (c), elt); |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2703 else |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2704 call2 (function, make_number (c), elt); |
20004 | 2705 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2706 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2707 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2708 |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2709 static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c)); |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2710 static void |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2711 void_call2 (a, b, c) |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2712 Lisp_Object a, b, c; |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2713 { |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2714 call2 (a, b, c); |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2715 } |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2716 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2717 DEFUN ("map-char-table", Fmap_char_table, Smap_char_table, |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2718 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2719 doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2720 FUNCTION is called with two arguments--a key and a value. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2721 The key is always a possible IDX argument to `aref'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2722 (function, char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2723 Lisp_Object function, char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2724 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2725 /* 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
|
2726 Lisp_Object indices[3]; |
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2727 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2728 CHECK_CHAR_TABLE (char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2729 |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2730 /* When Lisp_Object is represented as a union, `call2' cannot directly |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2731 be passed to map_char_table because it returns a Lisp_Object rather |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2732 than returning nothing. |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2733 Casting leads to crashes on some architectures. -stef */ |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2734 map_char_table (void_call2, Qnil, char_table, function, 0, indices); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2735 return Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2736 } |
30488
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2737 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2738 /* Return a value for character C in char-table TABLE. Store the |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2739 actual index for that value in *IDX. Ignore the default value of |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2740 TABLE. */ |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2741 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2742 Lisp_Object |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2743 char_table_ref_and_index (table, c, idx) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2744 Lisp_Object table; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2745 int c, *idx; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2746 { |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2747 int charset, c1, c2; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2748 Lisp_Object elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2749 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2750 if (SINGLE_BYTE_CHAR_P (c)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2751 { |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2752 *idx = c; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2753 return XCHAR_TABLE (table)->contents[c]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2754 } |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2755 SPLIT_CHAR (c, charset, c1, c2); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2756 elt = XCHAR_TABLE (table)->contents[charset + 128]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2757 *idx = MAKE_CHAR (charset, 0, 0); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2758 if (!SUB_CHAR_TABLE_P (elt)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2759 return elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2760 if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1])) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2761 return XCHAR_TABLE (elt)->defalt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2762 elt = XCHAR_TABLE (elt)->contents[c1]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2763 *idx = MAKE_CHAR (charset, c1, 0); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2764 if (!SUB_CHAR_TABLE_P (elt)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2765 return elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2766 if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2])) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2767 return XCHAR_TABLE (elt)->defalt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2768 *idx = c; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2769 return XCHAR_TABLE (elt)->contents[c2]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2770 } |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2771 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2772 |
211 | 2773 /* ARGSUSED */ |
2774 Lisp_Object | |
2775 nconc2 (s1, s2) | |
2776 Lisp_Object s1, s2; | |
2777 { | |
2778 #ifdef NO_ARG_ARRAY | |
2779 Lisp_Object args[2]; | |
2780 args[0] = s1; | |
2781 args[1] = s2; | |
2782 return Fnconc (2, args); | |
2783 #else | |
2784 return Fnconc (2, &s1); | |
2785 #endif /* NO_ARG_ARRAY */ | |
2786 } | |
2787 | |
2788 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2789 doc: /* Concatenate any number of lists by altering them. |
40132
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
2790 Only the last argument is not altered, and need not be a list. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
2791 usage: (nconc &rest LISTS) */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2792 (nargs, args) |
211 | 2793 int nargs; |
2794 Lisp_Object *args; | |
2795 { | |
2796 register int argnum; | |
2797 register Lisp_Object tail, tem, val; | |
2798 | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2799 val = tail = Qnil; |
211 | 2800 |
2801 for (argnum = 0; argnum < nargs; argnum++) | |
2802 { | |
2803 tem = args[argnum]; | |
485 | 2804 if (NILP (tem)) continue; |
211 | 2805 |
485 | 2806 if (NILP (val)) |
211 | 2807 val = tem; |
2808 | |
2809 if (argnum + 1 == nargs) break; | |
2810 | |
2811 if (!CONSP (tem)) | |
2812 tem = wrong_type_argument (Qlistp, tem); | |
2813 | |
2814 while (CONSP (tem)) | |
2815 { | |
2816 tail = tem; | |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2817 tem = XCDR (tail); |
211 | 2818 QUIT; |
2819 } | |
2820 | |
2821 tem = args[argnum + 1]; | |
2822 Fsetcdr (tail, tem); | |
485 | 2823 if (NILP (tem)) |
211 | 2824 args[argnum + 1] = tail; |
2825 } | |
2826 | |
2827 return val; | |
2828 } | |
2829 | |
2830 /* 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
|
2831 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
|
2832 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
|
2833 LENI is the length of VALS, which should also be the length of SEQ. */ |
211 | 2834 |
2835 static void | |
2836 mapcar1 (leni, vals, fn, seq) | |
2837 int leni; | |
2838 Lisp_Object *vals; | |
2839 Lisp_Object fn, seq; | |
2840 { | |
2841 register Lisp_Object tail; | |
2842 Lisp_Object dummy; | |
2843 register int i; | |
2844 struct gcpro gcpro1, gcpro2, gcpro3; | |
2845 | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2846 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2847 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2848 /* Don't let vals contain any garbage when GC happens. */ |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2849 for (i = 0; i < leni; i++) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2850 vals[i] = Qnil; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2851 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2852 GCPRO3 (dummy, fn, seq); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2853 gcpro1.var = vals; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2854 gcpro1.nvars = leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2855 } |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2856 else |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2857 GCPRO2 (fn, seq); |
211 | 2858 /* We need not explicitly protect `tail' because it is used only on lists, and |
2859 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ | |
2860 | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2861 if (VECTORP (seq)) |
211 | 2862 { |
2863 for (i = 0; i < leni; i++) | |
2864 { | |
2865 dummy = XVECTOR (seq)->contents[i]; | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2866 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2867 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2868 vals[i] = dummy; |
211 | 2869 } |
2870 } | |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2871 else if (BOOL_VECTOR_P (seq)) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2872 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2873 for (i = 0; i < leni; i++) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2874 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2875 int byte; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2876 byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR]; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2877 if (byte & (1 << (i % BITS_PER_CHAR))) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2878 dummy = Qt; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2879 else |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2880 dummy = Qnil; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2881 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2882 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2883 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2884 vals[i] = dummy; |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2885 } |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2886 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2887 else if (STRINGP (seq)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2888 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2889 int i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2890 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2891 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
|
2892 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2893 int c; |
20712
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2894 int i_before = i; |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2895 |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2896 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
|
2897 XSETFASTINT (dummy, c); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2898 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2899 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2900 vals[i_before] = dummy; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2901 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2902 } |
211 | 2903 else /* Must be a list, since Flength did not get an error */ |
2904 { | |
2905 tail = seq; | |
2906 for (i = 0; i < leni; i++) | |
2907 { | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2908 dummy = call1 (fn, Fcar (tail)); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2909 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2910 vals[i] = dummy; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2911 tail = XCDR (tail); |
211 | 2912 } |
2913 } | |
2914 | |
2915 UNGCPRO; | |
2916 } | |
2917 | |
2918 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2919 doc: /* Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. |
39956
b394d7876697
(Fmapconcat): Fix typo in a doc string.
Pavel Janík <Pavel@Janik.cz>
parents:
39899
diff
changeset
|
2920 In between each pair of results, stick in SEPARATOR. Thus, " " as |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2921 SEPARATOR results in spaces between the values returned by FUNCTION. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2922 SEQUENCE may be a list, a vector, a bool-vector, or a string. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2923 (function, sequence, separator) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2924 Lisp_Object function, sequence, separator; |
211 | 2925 { |
2926 Lisp_Object len; | |
2927 register int leni; | |
2928 int nargs; | |
2929 register Lisp_Object *args; | |
2930 register int i; | |
2931 struct gcpro gcpro1; | |
2932 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2933 len = Flength (sequence); |
211 | 2934 leni = XINT (len); |
2935 nargs = leni + leni - 1; | |
2936 if (nargs < 0) return build_string (""); | |
2937 | |
2938 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object)); | |
2939 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2940 GCPRO1 (separator); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2941 mapcar1 (leni, args, function, sequence); |
211 | 2942 UNGCPRO; |
2943 | |
2944 for (i = leni - 1; i >= 0; i--) | |
2945 args[i + i] = args[i]; | |
20004 | 2946 |
211 | 2947 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
|
2948 args[i] = separator; |
211 | 2949 |
2950 return Fconcat (nargs, args); | |
2951 } | |
2952 | |
2953 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2954 doc: /* Apply FUNCTION to each element of SEQUENCE, and make a list of the results. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2955 The result is a list just as long as SEQUENCE. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2956 SEQUENCE may be a list, a vector, a bool-vector, or a string. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2957 (function, sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2958 Lisp_Object function, sequence; |
211 | 2959 { |
2960 register Lisp_Object len; | |
2961 register int leni; | |
2962 register Lisp_Object *args; | |
2963 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2964 len = Flength (sequence); |
211 | 2965 leni = XFASTINT (len); |
2966 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object)); | |
2967 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2968 mapcar1 (leni, args, function, sequence); |
211 | 2969 |
2970 return Flist (leni, args); | |
2971 } | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2972 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2973 DEFUN ("mapc", Fmapc, Smapc, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2974 doc: /* Apply FUNCTION to each element of SEQUENCE for side effects only. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2975 Unlike `mapcar', don't accumulate the results. Return SEQUENCE. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2976 SEQUENCE may be a list, a vector, a bool-vector, or a string. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2977 (function, sequence) |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2978 Lisp_Object function, sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2979 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2980 register int leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2981 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2982 leni = XFASTINT (Flength (sequence)); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2983 mapcar1 (leni, 0, function, sequence); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2984 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2985 return sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2986 } |
211 | 2987 |
2988 /* Anything that calls this function must protect from GC! */ | |
2989 | |
2990 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2991 doc: /* Ask user a "y or n" question. Return t if answer is "y". |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2992 Takes one argument, which is the string to display to ask the question. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2993 It should end in a space; `y-or-n-p' adds `(y or n) ' to it. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2994 No confirmation of the answer is requested; a single character is enough. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2995 Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2996 the bindings in `query-replace-map'; see the documentation of that variable |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2997 for more information. In this case, the useful bindings are `act', `skip', |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2998 `recenter', and `quit'.\) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2999 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3000 Under a windowing system a dialog box will be used if `last-nonmenu-event' |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3001 is nil and `use-dialog-box' is non-nil. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3002 (prompt) |
211 | 3003 Lisp_Object prompt; |
3004 { | |
25071 | 3005 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
|
3006 register int answer; |
211 | 3007 Lisp_Object xprompt; |
3008 Lisp_Object args[2]; | |
3009 struct gcpro gcpro1, gcpro2; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
3010 int count = SPECPDL_INDEX (); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3011 |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3012 specbind (Qcursor_in_echo_area, Qt); |
211 | 3013 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3014 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
|
3015 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3016 CHECK_STRING (prompt); |
211 | 3017 xprompt = prompt; |
3018 GCPRO2 (prompt, xprompt); | |
3019 | |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
3020 #ifdef HAVE_X_WINDOWS |
36256
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents:
35513
diff
changeset
|
3021 if (display_hourglass_p) |
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents:
35513
diff
changeset
|
3022 cancel_hourglass (); |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
3023 #endif |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3024 |
211 | 3025 while (1) |
3026 { | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3027 |
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
|
3028 #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
|
3029 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
|
3030 && 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
|
3031 && 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
|
3032 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3033 Lisp_Object pane, menu; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
3034 redisplay_preserve_echo_area (3); |
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
|
3035 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
|
3036 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
|
3037 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
|
3038 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
|
3039 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
|
3040 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
|
3041 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
|
3042 } |
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
|
3043 #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
|
3044 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
|
3045 choose_minibuf_frame (); |
44524
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3046 |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3047 { |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3048 Lisp_Object pargs[3]; |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3049 |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3050 /* Colorize prompt according to `minibuffer-prompt' face. */ |
44524
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3051 pargs[0] = build_string ("%s(y or n) "); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3052 pargs[1] = intern ("face"); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3053 pargs[2] = intern ("minibuffer-prompt"); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3054 args[0] = Fpropertize (3, pargs); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3055 args[1] = xprompt; |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3056 Fmessage (2, args); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3057 } |
211 | 3058 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3059 if (minibuffer_auto_raise) |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3060 { |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3061 Lisp_Object mini_frame; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3062 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3063 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3064 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3065 Fraise_frame (mini_frame); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3066 } |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3067 |
23057
2dbf1ec20bf7
(Fy_or_n_p): Don't bind input-method-function.
Richard M. Stallman <rms@gnu.org>
parents:
23051
diff
changeset
|
3068 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
|
3069 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
|
3070 /* 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
|
3071 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
|
3072 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3073 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
|
3074 def = Flookup_key (map, key, Qt); |
211 | 3075 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3076 if (EQ (def, intern ("skip"))) |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3077 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3078 answer = 0; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3079 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3080 } |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3081 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
|
3082 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3083 answer = 1; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3084 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3085 } |
2311
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3086 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
|
3087 { |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3088 Frecenter (Qnil); |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3089 xprompt = prompt; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3090 continue; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3091 } |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3092 else if (EQ (def, intern ("quit"))) |
211 | 3093 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
|
3094 /* 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
|
3095 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
|
3096 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
|
3097 Vquit_flag = Qt; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3098 |
211 | 3099 QUIT; |
1194 | 3100 |
3101 /* If we don't clear this, then the next call to read_char will | |
3102 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
|
3103 Vquit_flag = Qnil; |
211 | 3104 |
3105 Fding (Qnil); | |
3106 Fdiscard_input (); | |
3107 if (EQ (xprompt, prompt)) | |
3108 { | |
3109 args[0] = build_string ("Please answer y or n. "); | |
3110 args[1] = prompt; | |
3111 xprompt = Fconcat (2, args); | |
3112 } | |
3113 } | |
3114 UNGCPRO; | |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
3115 |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3116 if (! noninteractive) |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3117 { |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3118 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
|
3119 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
|
3120 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
|
3121 } |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
3122 |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3123 unbind_to (count, Qnil); |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3124 return answer ? Qt : Qnil; |
211 | 3125 } |
3126 | |
3127 /* This is how C code calls `yes-or-no-p' and allows the user | |
3128 to redefined it. | |
3129 | |
3130 Anything that calls this function must protect from GC! */ | |
3131 | |
3132 Lisp_Object | |
3133 do_yes_or_no_p (prompt) | |
3134 Lisp_Object prompt; | |
3135 { | |
3136 return call1 (intern ("yes-or-no-p"), prompt); | |
3137 } | |
3138 | |
3139 /* Anything that calls this function must protect from GC! */ | |
3140 | |
3141 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3142 doc: /* Ask user a yes-or-no question. Return t if answer is yes. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3143 Takes one argument, which is the string to display to ask the question. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3144 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3145 The user must confirm the answer with RET, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3146 and can edit it until it has been confirmed. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3147 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3148 Under a windowing system a dialog box will be used if `last-nonmenu-event' |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3149 is nil, and `use-dialog-box' is non-nil. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3150 (prompt) |
211 | 3151 Lisp_Object prompt; |
3152 { | |
3153 register Lisp_Object ans; | |
3154 Lisp_Object args[2]; | |
3155 struct gcpro gcpro1; | |
3156 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3157 CHECK_STRING (prompt); |
211 | 3158 |
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
|
3159 #ifdef HAVE_MENUS |
20004 | 3160 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
|
3161 && 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
|
3162 && 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
|
3163 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3164 Lisp_Object pane, menu, obj; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
3165 redisplay_preserve_echo_area (4); |
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
|
3166 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
|
3167 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
|
3168 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
|
3169 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
|
3170 menu = Fcons (prompt, pane); |
6344 | 3171 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
|
3172 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
|
3173 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
|
3174 } |
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
|
3175 #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
|
3176 |
211 | 3177 args[0] = prompt; |
3178 args[1] = build_string ("(yes or no) "); | |
3179 prompt = Fconcat (2, args); | |
3180 | |
3181 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
|
3182 |
211 | 3183 while (1) |
3184 { | |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
3185 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
|
3186 Qyes_or_no_p_history, Qnil, |
6d3cc8864678
(Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents:
19383
diff
changeset
|
3187 Qnil)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3188 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes")) |
211 | 3189 { |
3190 UNGCPRO; | |
3191 return Qt; | |
3192 } | |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3193 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no")) |
211 | 3194 { |
3195 UNGCPRO; | |
3196 return Qnil; | |
3197 } | |
3198 | |
3199 Fding (Qnil); | |
3200 Fdiscard_input (); | |
3201 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
|
3202 Fsleep_for (make_number (2), Qnil); |
211 | 3203 } |
3204 } | |
3205 | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3206 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3207 doc: /* Return list of 1 minute, 5 minute and 15 minute load averages. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3208 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3209 Each of the three load averages is multiplied by 100, then converted |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3210 to integer. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3211 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3212 When USE-FLOATS is non-nil, floats will be used instead of integers. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3213 These floats are not multiplied by 100. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3214 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3215 If the 5-minute or 15-minute load averages are not available, return a |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3216 shortened list, containing only those averages which are available. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3217 (use_floats) |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3218 Lisp_Object use_floats; |
211 | 3219 { |
727 | 3220 double load_ave[3]; |
3221 int loads = getloadavg (load_ave, 3); | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3222 Lisp_Object ret = Qnil; |
211 | 3223 |
727 | 3224 if (loads < 0) |
3225 error ("load-average not implemented for this operating system"); | |
211 | 3226 |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3227 while (loads-- > 0) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3228 { |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3229 Lisp_Object load = (NILP (use_floats) ? |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3230 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
|
3231 : make_float (load_ave[loads])); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3232 ret = Fcons (load, ret); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3233 } |
211 | 3234 |
727 | 3235 return ret; |
211 | 3236 } |
3237 | |
39968
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
3238 Lisp_Object Vfeatures, Qsubfeatures; |
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
3239 extern Lisp_Object Vafter_load_alist; |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3240 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3241 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3242 doc: /* Returns t if FEATURE is present in this Emacs. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3243 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3244 Use this to conditionalize execution of lisp code based on the |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3245 presence or absence of emacs or environment extensions. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3246 Use `provide' to declare that a feature is available. This function |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3247 looks at the value of the variable `features'. The optional argument |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3248 SUBFEATURE can be used to check a specific subfeature of FEATURE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3249 (feature, subfeature) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3250 Lisp_Object feature, subfeature; |
211 | 3251 { |
3252 register Lisp_Object tem; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3253 CHECK_SYMBOL (feature); |
211 | 3254 tem = Fmemq (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3255 if (!NILP (tem) && !NILP (subfeature)) |
44066
d0bef01f3cb3
(Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents:
41006
diff
changeset
|
3256 tem = Fmember (subfeature, Fget (feature, Qsubfeatures)); |
485 | 3257 return (NILP (tem)) ? Qnil : Qt; |
211 | 3258 } |
3259 | |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3260 DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3261 doc: /* Announce that FEATURE is a feature of the current Emacs. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3262 The optional argument SUBFEATURES should be a list of symbols listing |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3263 particular subfeatures supported in this version of FEATURE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3264 (feature, subfeatures) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3265 Lisp_Object feature, subfeatures; |
211 | 3266 { |
3267 register Lisp_Object tem; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3268 CHECK_SYMBOL (feature); |
44066
d0bef01f3cb3
(Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents:
41006
diff
changeset
|
3269 CHECK_LIST (subfeatures); |
485 | 3270 if (!NILP (Vautoload_queue)) |
211 | 3271 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); |
3272 tem = Fmemq (feature, Vfeatures); | |
485 | 3273 if (NILP (tem)) |
211 | 3274 Vfeatures = Fcons (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3275 if (!NILP (subfeatures)) |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3276 Fput (feature, Qsubfeatures, subfeatures); |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
3277 LOADHIST_ATTACH (Fcons (Qprovide, feature)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3278 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3279 /* Run any load-hooks for this file. */ |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3280 tem = Fassq (feature, Vafter_load_alist); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
3281 if (CONSP (tem)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
3282 Fprogn (XCDR (tem)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3283 |
211 | 3284 return feature; |
3285 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3286 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3287 /* `require' and its subroutines. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3288 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3289 /* List of features currently being require'd, innermost first. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3290 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3291 Lisp_Object require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3292 |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
3293 Lisp_Object |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3294 require_unwind (old_value) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3295 Lisp_Object old_value; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3296 { |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
3297 return require_nesting_list = old_value; |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3298 } |
211 | 3299 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3300 DEFUN ("require", Frequire, Srequire, 1, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3301 doc: /* If feature FEATURE is not loaded, load it from FILENAME. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3302 If FEATURE is not a member of the list `features', then the feature |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3303 is not loaded; so load the file FILENAME. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3304 If FILENAME is omitted, the printname of FEATURE is used as the file name, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3305 and `load' will try to load this name appended with the suffix `.elc', |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3306 `.el' or the unmodified name, in that order. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3307 If the optional third argument NOERROR is non-nil, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3308 then return nil if the file is not found instead of signaling an error. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3309 Normally the return value is FEATURE. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3310 The normal messages at start and end of loading FILENAME are suppressed. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3311 (feature, filename, noerror) |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
3312 Lisp_Object feature, filename, noerror; |
211 | 3313 { |
3314 register Lisp_Object tem; | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3315 struct gcpro gcpro1, gcpro2; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3316 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3317 CHECK_SYMBOL (feature); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3318 |
211 | 3319 tem = Fmemq (feature, Vfeatures); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3320 |
485 | 3321 if (NILP (tem)) |
211 | 3322 { |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
3323 int count = SPECPDL_INDEX (); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3324 int nesting = 0; |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3325 |
48596
65f924c09e6d
(Frequire): Don't call LOADHIST_ATTACH if feature was
Dave Love <fx@gnu.org>
parents:
48567
diff
changeset
|
3326 LOADHIST_ATTACH (Fcons (Qrequire, feature)); |
65f924c09e6d
(Frequire): Don't call LOADHIST_ATTACH if feature was
Dave Love <fx@gnu.org>
parents:
48567
diff
changeset
|
3327 |
45039 | 3328 /* This is to make sure that loadup.el gives a clear picture |
3329 of what files are preloaded and when. */ | |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3330 if (! NILP (Vpurify_flag)) |
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3331 error ("(require %s) while preparing to dump", |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3332 SDATA (SYMBOL_NAME (feature))); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3333 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3334 /* A certain amount of recursive `require' is legitimate, |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3335 but if we require the same feature recursively 3 times, |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3336 signal an error. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3337 tem = require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3338 while (! NILP (tem)) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3339 { |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3340 if (! NILP (Fequal (feature, XCAR (tem)))) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3341 nesting++; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3342 tem = XCDR (tem); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3343 } |
48567
ecf43ac20827
fns.c (Frequire): Change nesting allowance from 2 to 3 to cause more
Steven Tamm <steventamm@mac.com>
parents:
48337
diff
changeset
|
3344 if (nesting > 3) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3345 error ("Recursive `require' for feature `%s'", |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3346 SDATA (SYMBOL_NAME (feature))); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3347 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3348 /* Update the list for any nested `require's that occur. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3349 record_unwind_protect (require_unwind, require_nesting_list); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3350 require_nesting_list = Fcons (feature, require_nesting_list); |
211 | 3351 |
3352 /* Value saved here is to be restored into Vautoload_queue */ | |
3353 record_unwind_protect (un_autoload, Vautoload_queue); | |
3354 Vautoload_queue = Qt; | |
3355 | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3356 /* Load the file. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3357 GCPRO2 (feature, filename); |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
3358 tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename, |
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
3359 noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil)); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3360 UNGCPRO; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3361 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3362 /* If load failed entirely, return nil. */ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3363 if (NILP (tem)) |
24016
43344f47a865
(Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents:
23927
diff
changeset
|
3364 return unbind_to (count, Qnil); |
211 | 3365 |
3366 tem = Fmemq (feature, Vfeatures); | |
485 | 3367 if (NILP (tem)) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3368 error ("Required feature `%s' was not provided", |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3369 SDATA (SYMBOL_NAME (feature))); |
211 | 3370 |
3371 /* Once loading finishes, don't undo it. */ | |
3372 Vautoload_queue = Qt; | |
3373 feature = unbind_to (count, feature); | |
3374 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3375 |
211 | 3376 return feature; |
3377 } | |
3378 | |
20004 | 3379 /* Primitives for work of the "widget" library. |
3380 In an ideal world, this section would not have been necessary. | |
3381 However, lisp function calls being as slow as they are, it turns | |
3382 out that some functions in the widget library (wid-edit.el) are the | |
3383 bottleneck of Widget operation. Here is their translation to C, | |
3384 for the sole reason of efficiency. */ | |
3385 | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3386 DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3387 doc: /* Return non-nil if PLIST has the property PROP. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3388 PLIST is a property list, which is a list of the form |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3389 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3390 Unlike `plist-get', this allows you to distinguish between a missing |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3391 property and a property with the value nil. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3392 The value is actually the tail of PLIST whose car is PROP. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3393 (plist, prop) |
20004 | 3394 Lisp_Object plist, prop; |
3395 { | |
3396 while (CONSP (plist) && !EQ (XCAR (plist), prop)) | |
3397 { | |
3398 QUIT; | |
3399 plist = XCDR (plist); | |
3400 plist = CDR (plist); | |
3401 } | |
3402 return plist; | |
3403 } | |
3404 | |
3405 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3406 doc: /* In WIDGET, set PROPERTY to VALUE. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3407 The value can later be retrieved with `widget-get'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3408 (widget, property, value) |
20004 | 3409 Lisp_Object widget, property, value; |
3410 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3411 CHECK_CONS (widget); |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
3412 XSETCDR (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
|
3413 return value; |
20004 | 3414 } |
3415 | |
3416 DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3417 doc: /* In WIDGET, get the value of PROPERTY. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3418 The value could either be specified when the widget was created, or |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3419 later with `widget-put'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3420 (widget, property) |
20004 | 3421 Lisp_Object widget, property; |
3422 { | |
3423 Lisp_Object tmp; | |
3424 | |
3425 while (1) | |
3426 { | |
3427 if (NILP (widget)) | |
3428 return Qnil; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3429 CHECK_CONS (widget); |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3430 tmp = Fplist_member (XCDR (widget), property); |
20004 | 3431 if (CONSP (tmp)) |
3432 { | |
3433 tmp = XCDR (tmp); | |
3434 return CAR (tmp); | |
3435 } | |
3436 tmp = XCAR (widget); | |
3437 if (NILP (tmp)) | |
3438 return Qnil; | |
3439 widget = Fget (tmp, Qwidget_type); | |
3440 } | |
3441 } | |
3442 | |
3443 DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3444 doc: /* Apply the value of WIDGET's PROPERTY to the widget itself. |
40132
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
3445 ARGS are passed as extra arguments to the function. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
3446 usage: (widget-apply WIDGET PROPERTY &rest ARGS) */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3447 (nargs, args) |
20004 | 3448 int nargs; |
3449 Lisp_Object *args; | |
3450 { | |
3451 /* This function can GC. */ | |
3452 Lisp_Object newargs[3]; | |
3453 struct gcpro gcpro1, gcpro2; | |
3454 Lisp_Object result; | |
3455 | |
3456 newargs[0] = Fwidget_get (args[0], args[1]); | |
3457 newargs[1] = args[0]; | |
3458 newargs[2] = Flist (nargs - 2, args + 2); | |
3459 GCPRO2 (newargs[0], newargs[2]); | |
3460 result = Fapply (3, newargs); | |
3461 UNGCPRO; | |
3462 return result; | |
3463 } | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3464 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3465 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3466 #include <langinfo.h> |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3467 #endif |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3468 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3469 DEFUN ("langinfo", Flanginfo, Slanginfo, 1, 1, 0, |
49798 | 3470 doc: /* Access locale data ITEM, if available. |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3471 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3472 ITEM may be one of the following: |
49798 | 3473 `codeset', returning the character set as a string (locale item CODESET); |
3474 `days', returning a 7-element vector of day names (locale items DAY_n); | |
3475 `months', returning a 12-element vector of month names (locale items MON_n); | |
3476 `paper', returning a list (WIDTH, HEIGHT) for the default paper size, | |
3477 where the width and height are in mm (locale items PAPER_WIDTH, | |
3478 PAPER_HEIGHT). | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3479 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3480 If the system can't provide such information through a call to |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3481 nl_langinfo(3), return nil. |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3482 |
49798 | 3483 See also Info node `(libc)Locales'. |
3484 | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3485 The data read from the system are decoded using `locale-coding-system'. */) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3486 (item) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3487 Lisp_Object item; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3488 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3489 char *str = NULL; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3490 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3491 Lisp_Object val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3492 if (EQ (item, Qcodeset)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3493 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3494 str = nl_langinfo (CODESET); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3495 return build_string (str); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3496 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3497 #ifdef DAY_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3498 else if (EQ (item, Qdays)) /* e.g. for calendar-day-name-array */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3499 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3500 Lisp_Object v = Fmake_vector (make_number (7), Qnil); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3501 int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7}; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3502 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3503 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3504 for (i = 0; i < 7; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3505 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3506 str = nl_langinfo (days[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3507 val = make_unibyte_string (str, strlen (str)); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3508 /* Fixme: Is this coding system necessarily right, even if |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3509 it is consistent with CODESET? If not, what to do? */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3510 Faset (v, make_number (i), |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3511 code_convert_string_norecord (val, Vlocale_coding_system, |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
3512 0)); |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3513 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3514 return v; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3515 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3516 #endif /* DAY_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3517 #ifdef MON_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3518 else if (EQ (item, Qmonths)) /* e.g. for calendar-month-name-array */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3519 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3520 struct Lisp_Vector *p = allocate_vector (12); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3521 int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7, |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3522 MON_8, MON_9, MON_10, MON_11, MON_12}; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3523 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3524 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3525 for (i = 0; i < 12; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3526 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3527 str = nl_langinfo (months[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3528 val = make_unibyte_string (str, strlen (str)); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3529 p->contents[i] = |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
3530 code_convert_string_norecord (val, Vlocale_coding_system, 0); |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3531 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3532 XSETVECTOR (val, p); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3533 return val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3534 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3535 #endif /* MON_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3536 /* LC_PAPER stuff isn't defined as accessible in glibc as of 2.3.1, |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3537 but is in the locale files. This could be used by ps-print. */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3538 #ifdef PAPER_WIDTH |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3539 else if (EQ (item, Qpaper)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3540 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3541 return list2 (make_number (nl_langinfo (PAPER_WIDTH)), |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3542 make_number (nl_langinfo (PAPER_HEIGHT))); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3543 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3544 #endif /* PAPER_WIDTH */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3545 #endif /* HAVE_LANGINFO_CODESET*/ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3546 return Qnil; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3547 } |
20004 | 3548 |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3549 /* base64 encode/decode functions (RFC 2045). |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3550 Based on code from GNU recode. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3551 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3552 #define MIME_LINE_LENGTH 76 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3553 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3554 #define IS_ASCII(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3555 ((Character) < 128) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3556 #define IS_BASE64(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3557 (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
|
3558 #define IS_BASE64_IGNORABLE(Character) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3559 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3560 || (Character) == '\f' || (Character) == '\r') |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3561 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3562 /* 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
|
3563 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
|
3564 process. */ |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3565 #define READ_QUADRUPLET_BYTE(retval) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3566 do \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3567 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3568 if (i == length) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3569 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3570 if (nchars_return) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3571 *nchars_return = nchars; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3572 return (retval); \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3573 } \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3574 c = from[i++]; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3575 } \ |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3576 while (IS_BASE64_IGNORABLE (c)) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3577 |
23690 | 3578 /* Don't use alloca for regions larger than this, lest we overflow |
3579 their stack. */ | |
3580 #define MAX_ALLOCA 16*1024 | |
3581 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3582 /* 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
|
3583 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
|
3584 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3585 '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
|
3586 '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
|
3587 '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
|
3588 '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
|
3589 '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
|
3590 '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
|
3591 '8', '9', '+', '/' /* 60-63 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3592 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3593 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3594 /* 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
|
3595 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
|
3596 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3597 -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
|
3598 -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
|
3599 -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
|
3600 -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
|
3601 -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
|
3602 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
|
3603 -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
|
3604 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
|
3605 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
|
3606 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
|
3607 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
|
3608 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
|
3609 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
|
3610 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3611 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3612 /* 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
|
3613 get transformed into four base64 characters. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3614 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3615 .--------. .--------. .--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3616 |aaaaaabb| |bbbbcccc| |ccdddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3617 `--------' `--------' `--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3618 6 2 4 4 2 6 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3619 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3620 |00aaaaaa|00bbbbbb|00cccccc|00dddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3621 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3622 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3623 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3624 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3625 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3626 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3627 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
|
3628 base64 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3629 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3630 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3631 static int base64_encode_1 P_ ((const char *, char *, int, int, int)); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3632 static int base64_decode_1 P_ ((const char *, char *, int, int, int *)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3633 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3634 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
|
3635 2, 3, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3636 doc: /* Base64-encode the region between BEG and END. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3637 Return the length of the encoded text. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3638 Optional third argument NO-LINE-BREAK means do not break long lines |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3639 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3640 (beg, end, no_line_break) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3641 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
|
3642 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3643 char *encoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3644 int allength, length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3645 int ibeg, iend, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3646 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3647 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3648 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3649 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3650 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3651 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3652 move_gap_both (XFASTINT (beg), ibeg); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3653 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3654 /* 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
|
3655 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
|
3656 characters, and then we round up. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3657 length = iend - ibeg; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3658 allength = length + length/3 + 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3659 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
|
3660 |
23690 | 3661 if (allength <= MAX_ALLOCA) |
3662 encoded = (char *) alloca (allength); | |
3663 else | |
3664 encoded = (char *) xmalloc (allength); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3665 encoded_length = base64_encode_1 (BYTE_POS_ADDR (ibeg), encoded, length, |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3666 NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3667 !NILP (current_buffer->enable_multibyte_characters)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3668 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3669 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3670 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3671 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3672 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3673 /* The encoding wasn't possible. */ |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3674 if (length > MAX_ALLOCA) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3675 xfree (encoded); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3676 error ("Multibyte character in data for base64 encoding"); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3677 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3678 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3679 /* 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
|
3680 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
|
3681 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
|
3682 insert (encoded, encoded_length); |
23690 | 3683 if (allength > MAX_ALLOCA) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3684 xfree (encoded); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3685 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
|
3686 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3687 /* 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
|
3688 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
|
3689 if (old_pos >= XFASTINT (end)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3690 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
|
3691 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
|
3692 old_pos = XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3693 SET_PT (old_pos); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3694 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3695 /* 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
|
3696 return make_number (encoded_length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3697 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3698 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3699 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
|
3700 1, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3701 doc: /* Base64-encode STRING and return the result. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3702 Optional second argument NO-LINE-BREAK means do not break long lines |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3703 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3704 (string, no_line_break) |
24377
f881dd22ec7d
(Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents:
24334
diff
changeset
|
3705 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
|
3706 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3707 int allength, length, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3708 char *encoded; |
23690 | 3709 Lisp_Object encoded_string; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3710 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3711 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3712 |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3713 /* 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
|
3714 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
|
3715 characters, and then we round up. */ |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3716 length = SBYTES (string); |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3717 allength = length + length/3 + 1; |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3718 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
|
3719 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3720 /* We need to allocate enough room for decoding the text. */ |
23690 | 3721 if (allength <= MAX_ALLOCA) |
3722 encoded = (char *) alloca (allength); | |
3723 else | |
3724 encoded = (char *) xmalloc (allength); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3725 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3726 encoded_length = base64_encode_1 (SDATA (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3727 encoded, length, NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3728 STRING_MULTIBYTE (string)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3729 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3730 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3731 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3732 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3733 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3734 /* The encoding wasn't possible. */ |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3735 if (length > MAX_ALLOCA) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3736 xfree (encoded); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3737 error ("Multibyte character in data for base64 encoding"); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3738 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3739 |
23690 | 3740 encoded_string = make_unibyte_string (encoded, encoded_length); |
3741 if (allength > MAX_ALLOCA) | |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3742 xfree (encoded); |
23690 | 3743 |
3744 return encoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3745 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3746 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3747 static int |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3748 base64_encode_1 (from, to, length, line_break, multibyte) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3749 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3750 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3751 int length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3752 int line_break; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3753 int multibyte; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3754 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3755 int counter = 0, i = 0; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3756 char *e = to; |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3757 int c; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3758 unsigned int value; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3759 int bytes; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3760 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3761 while (i < length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3762 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3763 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3764 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3765 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3766 if (c >= 256) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3767 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3768 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3769 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3770 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3771 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3772 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3773 /* Wrap line every 76 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3774 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3775 if (line_break) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3776 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3777 if (counter < MIME_LINE_LENGTH / 4) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3778 counter++; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3779 else |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3780 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3781 *e++ = '\n'; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3782 counter = 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3783 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3784 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3785 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3786 /* Process first byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3787 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3788 *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
|
3789 value = (0x03 & c) << 4; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3790 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3791 /* Process second byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3792 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3793 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3794 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3795 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3796 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3797 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3798 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3799 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3800 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3801 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3802 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3803 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3804 if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3805 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3806 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3807 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3808 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3809 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3810 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3811 *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
|
3812 value = (0x0f & c) << 2; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3813 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3814 /* Process third byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3815 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3816 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3817 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3818 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3819 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3820 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3821 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3822 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3823 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3824 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3825 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3826 if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3827 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3828 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3829 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3830 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3831 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3832 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3833 *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
|
3834 *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
|
3835 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3836 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3837 return e - to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3838 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3839 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3840 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3841 DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region, |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3842 2, 2, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3843 doc: /* Base64-decode the region between BEG and END. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3844 Return the length of the decoded text. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3845 If the region can't be decoded, signal an error and don't modify the buffer. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3846 (beg, end) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3847 Lisp_Object beg, end; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3848 { |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3849 int ibeg, iend, length, allength; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3850 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3851 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3852 int decoded_length; |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3853 int inserted_chars; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3854 int multibyte = !NILP (current_buffer->enable_multibyte_characters); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3855 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3856 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3857 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3858 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3859 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3860 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3861 length = iend - ibeg; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3862 |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3863 /* We need to allocate enough room for decoding the text. If we are |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3864 working on a multibyte buffer, each decoded code may occupy at |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3865 most two bytes. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3866 allength = multibyte ? length * 2 : length; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3867 if (allength <= MAX_ALLOCA) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3868 decoded = (char *) alloca (allength); |
23690 | 3869 else |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3870 decoded = (char *) xmalloc (allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3871 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3872 move_gap_both (XFASTINT (beg), ibeg); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3873 decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length, |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3874 multibyte, &inserted_chars); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3875 if (decoded_length > allength) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3876 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3877 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3878 if (decoded_length < 0) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3879 { |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3880 /* The decoding wasn't possible. */ |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3881 if (allength > MAX_ALLOCA) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3882 xfree (decoded); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3883 error ("Invalid base64 data"); |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3884 } |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3885 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3886 /* 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
|
3887 and delete the old. (Insert first in order to preserve markers.) */ |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3888 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3889 insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3890 if (allength > MAX_ALLOCA) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3891 xfree (decoded); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3892 /* Delete the original text. */ |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3893 del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3894 iend + decoded_length, 1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3895 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3896 /* 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
|
3897 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
|
3898 if (old_pos >= XFASTINT (end)) |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3899 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
|
3900 else if (old_pos > XFASTINT (beg)) |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3901 old_pos = XFASTINT (beg); |
25607
e1f5592218c1
(Fbase64_decode_region): Don't place point outside of the
Richard M. Stallman <rms@gnu.org>
parents:
25590
diff
changeset
|
3902 SET_PT (old_pos > ZV ? ZV : old_pos); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3903 |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3904 return make_number (inserted_chars); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3905 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3906 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3907 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
|
3908 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3909 doc: /* Base64-decode STRING and return the result. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3910 (string) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3911 Lisp_Object string; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3912 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3913 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3914 int length, decoded_length; |
23690 | 3915 Lisp_Object decoded_string; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3916 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3917 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3918 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3919 length = SBYTES (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3920 /* We need to allocate enough room for decoding the text. */ |
23690 | 3921 if (length <= MAX_ALLOCA) |
3922 decoded = (char *) alloca (length); | |
3923 else | |
3924 decoded = (char *) xmalloc (length); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3925 |
32753
401f661f11d4
2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
32351
diff
changeset
|
3926 /* The decoded result should be unibyte. */ |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3927 decoded_length = base64_decode_1 (SDATA (string), decoded, length, |
32753
401f661f11d4
2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
32351
diff
changeset
|
3928 0, NULL); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3929 if (decoded_length > length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3930 abort (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
3931 else if (decoded_length >= 0) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3932 decoded_string = make_unibyte_string (decoded, decoded_length); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
3933 else |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3934 decoded_string = Qnil; |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3935 |
23690 | 3936 if (length > MAX_ALLOCA) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3937 xfree (decoded); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
3938 if (!STRINGP (decoded_string)) |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3939 error ("Invalid base64 data"); |
23690 | 3940 |
3941 return decoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3942 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3943 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3944 /* Base64-decode the data at FROM of LENGHT bytes into TO. If |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3945 MULTIBYTE is nonzero, the decoded result should be in multibyte |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3946 form. If NCHARS_RETRUN is not NULL, store the number of produced |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3947 characters in *NCHARS_RETURN. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3948 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3949 static int |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3950 base64_decode_1 (from, to, length, multibyte, nchars_return) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3951 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3952 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3953 int length; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3954 int multibyte; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3955 int *nchars_return; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3956 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3957 int i = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3958 char *e = to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3959 unsigned char c; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3960 unsigned long value; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3961 int nchars = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3962 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3963 while (1) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3964 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3965 /* Process first byte of a quadruplet. */ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3966 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3967 READ_QUADRUPLET_BYTE (e-to); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3968 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3969 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3970 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3971 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
|
3972 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3973 /* Process second byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3974 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3975 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3976 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3977 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3978 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3979 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
|
3980 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3981 c = (unsigned char) (value >> 16); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3982 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3983 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3984 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3985 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3986 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3987 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3988 /* Process third byte of a quadruplet. */ |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3989 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3990 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3991 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3992 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3993 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3994 READ_QUADRUPLET_BYTE (-1); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3995 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3996 if (c != '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3997 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3998 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3999 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4000 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4001 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4002 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4003 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
|
4004 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4005 c = (unsigned char) (0xff & value >> 8); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4006 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4007 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4008 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4009 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4010 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4011 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4012 /* Process fourth byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4013 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4014 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4015 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4016 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4017 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4018 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4019 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4020 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4021 value |= base64_char_to_value[c]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4022 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4023 c = (unsigned char) (0xff & value); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4024 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4025 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4026 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4027 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4028 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4029 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4030 } |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4033 |
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 ***** Hash Tables ***** |
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 /* Implemented by gerd@gnu.org. This hash table implementation was |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4041 inspired by CMUCL hash tables. */ |
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 /* Ideas: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4044 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4045 1. For small tables, association lists are probably faster than |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4046 hash tables because they have lower overhead. |
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 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
|
4049 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
|
4050 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
|
4051 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
|
4052 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
|
4053 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4054 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4055 /* 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
|
4056 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4057 Lisp_Object Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4058 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4059 /* Various symbols. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4060 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4061 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue; |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
4062 Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4063 Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4064 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4065 /* Function prototypes. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4066 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4067 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
|
4068 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
|
4069 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
|
4070 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
|
4071 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4072 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
|
4073 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4074 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
|
4075 unsigned, Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4076 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
|
4077 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
|
4078 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
|
4079 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4080 Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4081 static unsigned sxhash_string P_ ((unsigned char *, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4082 static unsigned sxhash_list P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4083 static unsigned sxhash_vector P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4084 static unsigned sxhash_bool_vector P_ ((Lisp_Object)); |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4085 static int sweep_weak_table P_ ((struct Lisp_Hash_Table *, int)); |
25005
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 |
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 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4090 Utilities |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4093 /* 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
|
4094 Lisp_Hash_Table. Otherwise, signal an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4095 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4096 static struct Lisp_Hash_Table * |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4097 check_hash_table (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4098 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4099 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
4100 CHECK_HASH_TABLE (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4101 return XHASH_TABLE (obj); |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4104 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4105 /* 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
|
4106 number. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4107 |
29979
6fe8f444b6a3
(next_almost_prime): Make it externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
29953
diff
changeset
|
4108 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4109 next_almost_prime (n) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4110 int n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4111 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4112 if (n % 2 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4113 n += 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4114 if (n % 3 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4115 n += 2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4116 if (n % 7 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4117 n += 4; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4118 return n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4119 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4120 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4121 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4122 /* 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
|
4123 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
|
4124 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
|
4125 -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
|
4126 a DEFUN parameter list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4127 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4128 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4129 get_key_arg (key, nargs, args, used) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4130 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4131 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4132 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4133 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4134 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4135 int i; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4136 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4137 for (i = 0; i < nargs - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4138 if (!used[i] && EQ (args[i], key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4139 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4140 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4141 if (i >= nargs - 1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4142 i = -1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4143 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4144 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4145 used[i++] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4146 used[i] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4147 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4148 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4149 return i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4150 } |
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 /* 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
|
4154 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
|
4155 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
|
4156 |
28481
3caab3235bc1
(larger_vector): Make externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
28222
diff
changeset
|
4157 Lisp_Object |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4158 larger_vector (vec, new_size, init) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4159 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4160 int new_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4161 Lisp_Object init; |
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 struct Lisp_Vector *v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4164 int i, old_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4165 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4166 xassert (VECTORP (vec)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4167 old_size = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4168 xassert (new_size >= old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4169 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4170 v = allocate_vector (new_size); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4171 bcopy (XVECTOR (vec)->contents, v->contents, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4172 old_size * sizeof *v->contents); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4173 for (i = old_size; i < new_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4174 v->contents[i] = init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4175 XSETVECTOR (vec, v); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4176 return vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4177 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4178 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4179 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4180 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4181 Low-level Functions |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4182 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4183 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4184 /* 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
|
4185 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
|
4186 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4187 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4188 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4189 cmpfn_eql (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4190 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4191 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4192 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4193 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4194 return (FLOATP (key1) |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4195 && FLOATP (key2) |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4196 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4197 } |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4200 /* 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
|
4201 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
|
4202 KEY2 are the same. */ |
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 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4205 cmpfn_equal (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4206 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4207 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4208 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4209 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4210 return hash1 == hash2 && !NILP (Fequal (key1, key2)); |
25005
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 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4213 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4214 /* 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
|
4215 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
|
4216 if KEY1 and KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4217 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4218 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4219 cmpfn_user_defined (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4220 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4221 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4222 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4223 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4224 if (hash1 == hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4225 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4226 Lisp_Object args[3]; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4227 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4228 args[0] = h->user_cmp_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4229 args[1] = key1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4230 args[2] = key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4231 return !NILP (Ffuncall (3, args)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4232 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4233 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4234 return 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4235 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4236 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4237 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4238 /* 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
|
4239 `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
|
4240 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4241 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4242 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4243 hashfn_eq (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4244 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4245 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4246 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4247 unsigned hash = XUINT (key) ^ XGCTYPE (key); |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4248 xassert ((hash & ~VALMASK) == 0); |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4249 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4250 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4251 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4252 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4253 /* 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
|
4254 `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
|
4255 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4256 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4257 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4258 hashfn_eql (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4259 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4260 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4261 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4262 unsigned hash; |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4263 if (FLOATP (key)) |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4264 hash = sxhash (key, 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4265 else |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4266 hash = XUINT (key) ^ XGCTYPE (key); |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4267 xassert ((hash & ~VALMASK) == 0); |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4268 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4269 } |
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 /* 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
|
4273 `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
|
4274 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4275 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4276 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4277 hashfn_equal (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4278 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4279 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4280 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4281 unsigned hash = sxhash (key, 0); |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4282 xassert ((hash & ~VALMASK) == 0); |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4283 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4284 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4285 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4286 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4287 /* 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
|
4288 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
|
4289 guaranteed to fit in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4290 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4291 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4292 hashfn_user_defined (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4293 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4294 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4295 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4296 Lisp_Object args[2], hash; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4297 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4298 args[0] = h->user_hash_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4299 args[1] = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4300 hash = Ffuncall (2, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4301 if (!INTEGERP (hash)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4302 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4303 list2 (build_string ("Invalid hash code returned from \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4304 user-supplied hash function"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4305 hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4306 return XUINT (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4307 } |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4310 /* Create and initialize a new hash table. |
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 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
|
4313 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
|
4314 `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
|
4315 test and hash functions USER_TEST and USER_HASH. |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4316 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4317 Give the table initial capacity SIZE, SIZE >= 0, an integer. |
25005
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 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
|
4320 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
|
4321 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
|
4322 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
|
4323 REHASH_SIZE. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4324 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4325 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
|
4326 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
|
4327 (table size) is >= REHASH_THRESHOLD. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4328 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4329 WEAK specifies the weakness of the table. If non-nil, it must be |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4330 one of the symbols `key', `value', `key-or-value', or `key-and-value'. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4331 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4332 Lisp_Object |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4333 make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4334 user_test, user_hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4335 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4336 Lisp_Object user_test, user_hash; |
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 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4339 Lisp_Object table; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4340 int index_size, i, sz; |
25005
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 /* Preconditions. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4343 xassert (SYMBOLP (test)); |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4344 xassert (INTEGERP (size) && XINT (size) >= 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4345 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4346 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4347 xassert (FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4348 && XFLOATINT (rehash_threshold) > 0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4349 && XFLOATINT (rehash_threshold) <= 1.0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4350 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4351 if (XFASTINT (size) == 0) |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4352 size = make_number (1); |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4353 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4354 /* Allocate a table and initialize it. */ |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4355 h = allocate_hash_table (); |
25005
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 /* Initialize hash table slots. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4358 sz = XFASTINT (size); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4359 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4360 h->test = test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4361 if (EQ (test, Qeql)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4362 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4363 h->cmpfn = cmpfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4364 h->hashfn = hashfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4365 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4366 else if (EQ (test, Qeq)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4367 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4368 h->cmpfn = NULL; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4369 h->hashfn = hashfn_eq; |
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 else if (EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4372 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4373 h->cmpfn = cmpfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4374 h->hashfn = hashfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4375 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4376 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4377 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4378 h->user_cmp_function = user_test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4379 h->user_hash_function = user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4380 h->cmpfn = cmpfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4381 h->hashfn = hashfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4382 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4383 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4384 h->weak = weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4385 h->rehash_threshold = rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4386 h->rehash_size = rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4387 h->count = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4388 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
|
4389 h->hash = Fmake_vector (size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4390 h->next = Fmake_vector (size, Qnil); |
29809
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4391 /* Cast to int here avoids losing with gcc 2.95 on Tru64/Alpha... */ |
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4392 index_size = next_almost_prime ((int) (sz / XFLOATINT (rehash_threshold))); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4393 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4394 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4395 /* Set up the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4396 for (i = 0; i < sz - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4397 HASH_NEXT (h, i) = make_number (i + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4398 h->next_free = make_number (0); |
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 XSET_HASH_TABLE (table, h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4401 xassert (HASH_TABLE_P (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4402 xassert (XHASH_TABLE (table) == h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4403 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4404 /* 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
|
4405 if (NILP (h->weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4406 h->next_weak = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4407 else |
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 h->next_weak = Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4410 Vweak_hash_tables = table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4411 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4412 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4413 return table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4414 } |
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 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4417 /* Return a copy of hash table H1. Keys and values are not copied, |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4418 only the table itself is. */ |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4419 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4420 Lisp_Object |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4421 copy_hash_table (h1) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4422 struct Lisp_Hash_Table *h1; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4423 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4424 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4425 struct Lisp_Hash_Table *h2; |
40769
fa1546836808
(copy_hash_table): Remove unused variable `v'.
Pavel Janík <Pavel@Janik.cz>
parents:
40734
diff
changeset
|
4426 struct Lisp_Vector *next; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4427 |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4428 h2 = allocate_hash_table (); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4429 next = h2->vec_next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4430 bcopy (h1, h2, sizeof *h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4431 h2->vec_next = next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4432 h2->key_and_value = Fcopy_sequence (h1->key_and_value); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4433 h2->hash = Fcopy_sequence (h1->hash); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4434 h2->next = Fcopy_sequence (h1->next); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4435 h2->index = Fcopy_sequence (h1->index); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4436 XSET_HASH_TABLE (table, h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4437 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4438 /* Maybe add this hash table to the list of all weak hash tables. */ |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4439 if (!NILP (h2->weak)) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4440 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4441 h2->next_weak = Vweak_hash_tables; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4442 Vweak_hash_tables = table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4443 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4444 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4445 return table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4446 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4447 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4448 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4449 /* 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
|
4450 because it's already too large, throw an error. */ |
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 static INLINE void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4453 maybe_resize_hash_table (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4454 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4455 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4456 if (NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4457 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4458 int old_size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4459 int i, new_size, index_size; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4460 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4461 if (INTEGERP (h->rehash_size)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4462 new_size = old_size + XFASTINT (h->rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4463 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4464 new_size = old_size * XFLOATINT (h->rehash_size); |
27901
70c1647c2bfc
(maybe_resize_hash_table): Handle case of new size
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4465 new_size = max (old_size + 1, new_size); |
29809
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4466 index_size = next_almost_prime ((int) |
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4467 (new_size |
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4468 / XFLOATINT (h->rehash_threshold))); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4469 if (max (index_size, 2 * new_size) & ~VALMASK) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4470 error ("Hash table too large to resize"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4471 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4472 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
|
4473 h->next = larger_vector (h->next, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4474 h->hash = larger_vector (h->hash, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4475 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4476 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4477 /* 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
|
4478 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
|
4479 maphash faster. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4480 for (i = old_size; i < new_size - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4481 HASH_NEXT (h, i) = make_number (i + 1); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4482 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4483 if (!NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4484 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4485 Lisp_Object last, next; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4486 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4487 last = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4488 while (next = HASH_NEXT (h, XFASTINT (last)), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4489 !NILP (next)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4490 last = next; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4491 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4492 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4493 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4494 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4495 XSETFASTINT (h->next_free, old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4496 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4497 /* Rehash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4498 for (i = 0; i < old_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4499 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4500 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4501 unsigned hash_code = XUINT (HASH_HASH (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4502 int start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4503 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4504 HASH_INDEX (h, start_of_bucket) = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4505 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4506 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4507 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4508 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4509 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4510 /* 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
|
4511 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
|
4512 matching KEY, or -1 if not found. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4513 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4514 int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4515 hash_lookup (h, key, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4516 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4517 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4518 unsigned *hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4519 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4520 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4521 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4522 Lisp_Object idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4523 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4524 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4525 if (hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4526 *hash = hash_code; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4527 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4528 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4529 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4530 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4531 /* We need not gcpro idx since it's either an integer or nil. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4532 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4533 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4534 int i = XFASTINT (idx); |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4535 if (EQ (key, HASH_KEY (h, i)) |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4536 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4537 && h->cmpfn (h, key, hash_code, |
28507
b6f06a755c7d
make_number/XINT/XUINT conversions; EQ/== fixes; ==Qnil -> NILP
Ken Raeburn <raeburn@raeburn.org>
parents:
28493
diff
changeset
|
4538 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4539 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4540 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4541 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4542 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4543 return NILP (idx) ? -1 : XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4544 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4545 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4546 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4547 /* Put an entry into hash table H that associates KEY with VALUE. |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4548 HASH is a previously computed hash code of KEY. |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4549 Value is the index of the entry in H matching KEY. */ |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4550 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4551 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4552 hash_put (h, key, value, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4553 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4554 Lisp_Object key, value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4555 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4556 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4557 int start_of_bucket, i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4558 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4559 xassert ((hash & ~VALMASK) == 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4560 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4561 /* Increment count after resizing because resizing may fail. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4562 maybe_resize_hash_table (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4563 h->count = make_number (XFASTINT (h->count) + 1); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4564 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4565 /* Store key/value in the key_and_value vector. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4566 i = XFASTINT (h->next_free); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4567 h->next_free = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4568 HASH_KEY (h, i) = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4569 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4570 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4571 /* Remember its hash code. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4572 HASH_HASH (h, i) = make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4573 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4574 /* Add new entry to its collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4575 start_of_bucket = hash % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4576 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4577 HASH_INDEX (h, start_of_bucket) = make_number (i); |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4578 return i; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4579 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4580 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4581 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4582 /* 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
|
4583 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4584 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4585 hash_remove (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4586 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4587 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4588 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4589 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4590 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4591 Lisp_Object idx, prev; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4592 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4593 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4594 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4595 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4596 prev = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4597 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4598 /* We need not gcpro idx, prev since they're either integers or nil. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4599 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4600 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4601 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4602 |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4603 if (EQ (key, HASH_KEY (h, i)) |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4604 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4605 && h->cmpfn (h, key, hash_code, |
28507
b6f06a755c7d
make_number/XINT/XUINT conversions; EQ/== fixes; ==Qnil -> NILP
Ken Raeburn <raeburn@raeburn.org>
parents:
28493
diff
changeset
|
4606 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4607 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4608 /* Take entry out of collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4609 if (NILP (prev)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4610 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4611 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4612 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4613 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4614 /* 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
|
4615 the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4616 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
|
4617 HASH_NEXT (h, i) = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4618 h->next_free = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4619 h->count = make_number (XFASTINT (h->count) - 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4620 xassert (XINT (h->count) >= 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4621 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4622 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4623 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4624 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4625 prev = idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4626 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4627 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4628 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4629 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4630 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4631 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4632 /* Clear hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4633 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4634 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4635 hash_clear (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4636 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4637 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4638 if (XFASTINT (h->count) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4639 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4640 int i, size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4641 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4642 for (i = 0; i < size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4643 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4644 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
|
4645 HASH_KEY (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4646 HASH_VALUE (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4647 HASH_HASH (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4648 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4649 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4650 for (i = 0; i < XVECTOR (h->index)->size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4651 XVECTOR (h->index)->contents[i] = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4652 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4653 h->next_free = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4654 h->count = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4655 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4656 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4657 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4658 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4659 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4660 /************************************************************************ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4661 Weak Hash Tables |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4662 ************************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4663 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4664 /* Sweep weak hash table H. REMOVE_ENTRIES_P non-zero means remove |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4665 entries from the table that don't survive the current GC. |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4666 REMOVE_ENTRIES_P zero means mark entries that are in use. Value is |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4667 non-zero if anything was marked. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4668 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4669 static int |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4670 sweep_weak_table (h, remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4671 struct Lisp_Hash_Table *h; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4672 int remove_entries_p; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4673 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4674 int bucket, n, marked; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4675 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4676 n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4677 marked = 0; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4678 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4679 for (bucket = 0; bucket < n; ++bucket) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4680 { |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4681 Lisp_Object idx, next, prev; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4682 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4683 /* Follow collision chain, removing entries that |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4684 don't survive this garbage collection. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4685 prev = Qnil; |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4686 for (idx = HASH_INDEX (h, bucket); !GC_NILP (idx); idx = next) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4687 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4688 int i = XFASTINT (idx); |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4689 int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i)); |
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4690 int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i)); |
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4691 int remove_p; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4692 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4693 if (EQ (h->weak, Qkey)) |
30007
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4694 remove_p = !key_known_to_survive_p; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4695 else if (EQ (h->weak, Qvalue)) |
30007
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4696 remove_p = !value_known_to_survive_p; |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4697 else if (EQ (h->weak, Qkey_or_value)) |
30637
b54946f3cbbc
(sweep_weak_table): Fix survival conditions for
Gerd Moellmann <gerd@gnu.org>
parents:
30634
diff
changeset
|
4698 remove_p = !(key_known_to_survive_p || value_known_to_survive_p); |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4699 else if (EQ (h->weak, Qkey_and_value)) |
30637
b54946f3cbbc
(sweep_weak_table): Fix survival conditions for
Gerd Moellmann <gerd@gnu.org>
parents:
30634
diff
changeset
|
4700 remove_p = !(key_known_to_survive_p && value_known_to_survive_p); |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4701 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4702 abort (); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4703 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4704 next = HASH_NEXT (h, i); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4705 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4706 if (remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4707 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4708 if (remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4709 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4710 /* Take out of collision chain. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4711 if (GC_NILP (prev)) |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4712 HASH_INDEX (h, bucket) = next; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4713 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4714 HASH_NEXT (h, XFASTINT (prev)) = next; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4715 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4716 /* Add to free list. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4717 HASH_NEXT (h, i) = h->next_free; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4718 h->next_free = idx; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4719 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4720 /* Clear key, value, and hash. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4721 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4722 HASH_HASH (h, i) = Qnil; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4723 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4724 h->count = make_number (XFASTINT (h->count) - 1); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4725 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4726 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4727 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4728 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4729 if (!remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4730 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4731 /* Make sure key and value survive. */ |
30007
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4732 if (!key_known_to_survive_p) |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4733 { |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4734 mark_object (&HASH_KEY (h, i)); |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4735 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4736 } |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4737 |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4738 if (!value_known_to_survive_p) |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4739 { |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4740 mark_object (&HASH_VALUE (h, i)); |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4741 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4742 } |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4743 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4744 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4745 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4746 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4747 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4748 return marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4749 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4750 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4751 /* 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
|
4752 current garbage collection. Remove weak tables that don't survive |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4753 from Vweak_hash_tables. Called from gc_sweep. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4754 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4755 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4756 sweep_weak_hash_tables () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4757 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4758 Lisp_Object table, used, next; |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4759 struct Lisp_Hash_Table *h; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4760 int marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4761 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4762 /* Mark all keys and values that are in use. Keep on marking until |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4763 there is no more change. This is necessary for cases like |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4764 value-weak table A containing an entry X -> Y, where Y is used in a |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4765 key-weak table B, Z -> Y. If B comes after A in the list of weak |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4766 tables, X -> Y might be removed from A, although when looking at B |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4767 one finds that it shouldn't. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4768 do |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4769 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4770 marked = 0; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4771 for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4772 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4773 h = XHASH_TABLE (table); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4774 if (h->size & ARRAY_MARK_FLAG) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4775 marked |= sweep_weak_table (h, 0); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4776 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4777 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4778 while (marked); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4779 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4780 /* Remove tables and entries that aren't used. */ |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4781 for (table = Vweak_hash_tables, used = Qnil; !GC_NILP (table); table = next) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4782 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4783 h = XHASH_TABLE (table); |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4784 next = h->next_weak; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4785 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4786 if (h->size & ARRAY_MARK_FLAG) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4787 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4788 /* TABLE is marked as used. Sweep its contents. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4789 if (XFASTINT (h->count) > 0) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4790 sweep_weak_table (h, 1); |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4791 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4792 /* Add table to the list of used weak hash tables. */ |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4793 h->next_weak = used; |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4794 used = table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4795 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4796 } |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4797 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4798 Vweak_hash_tables = used; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4799 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4800 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4801 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4802 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4803 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4804 Hash Code Computation |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4805 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4806 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4807 /* Maximum depth up to which to dive into Lisp structures. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4808 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4809 #define SXHASH_MAX_DEPTH 3 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4810 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4811 /* 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
|
4812 account. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4813 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4814 #define SXHASH_MAX_LEN 7 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4815 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4816 /* Combine two integers X and Y for hashing. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4817 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4818 #define SXHASH_COMBINE(X, Y) \ |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
4819 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4820 + (unsigned)(Y)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4821 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4822 |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4823 /* Return a hash for string PTR which has length LEN. The hash |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4824 code returned is guaranteed to fit in a Lisp integer. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4825 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4826 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4827 sxhash_string (ptr, len) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4828 unsigned char *ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4829 int len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4830 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4831 unsigned char *p = ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4832 unsigned char *end = p + len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4833 unsigned char c; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4834 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4835 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4836 while (p != end) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4837 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4838 c = *p++; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4839 if (c >= 0140) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4840 c -= 40; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4841 hash = ((hash << 3) + (hash >> 28) + c); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4842 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4843 |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4844 return hash & VALMASK; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4845 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4846 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4847 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4848 /* 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
|
4849 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
|
4850 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4851 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4852 sxhash_list (list, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4853 Lisp_Object list; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4854 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4855 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4856 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4857 int i; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4858 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4859 if (depth < SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4860 for (i = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4861 CONSP (list) && i < SXHASH_MAX_LEN; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4862 list = XCDR (list), ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4863 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4864 unsigned hash2 = sxhash (XCAR (list), depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4865 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4866 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4867 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4868 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4869 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4870 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4871 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4872 /* 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
|
4873 the Lisp structure. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4874 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4875 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4876 sxhash_vector (vec, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4877 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4878 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4879 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4880 unsigned hash = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4881 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4882 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4883 n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4884 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4885 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4886 unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4887 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4888 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4889 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4890 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4891 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4892 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4893 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4894 /* Return a hash for bool-vector VECTOR. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4895 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4896 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4897 sxhash_bool_vector (vec) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4898 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4899 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4900 unsigned hash = XBOOL_VECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4901 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4902 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4903 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4904 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4905 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4906 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4907 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4908 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4909 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4910 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4911 /* 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
|
4912 structure. Value is an unsigned integer clipped to VALMASK. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4913 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4914 unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4915 sxhash (obj, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4916 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4917 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4918 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4919 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4920 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4921 if (depth > SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4922 return 0; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4923 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4924 switch (XTYPE (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4925 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4926 case Lisp_Int: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4927 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4928 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4929 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4930 case Lisp_Symbol: |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4931 hash = sxhash_string (SDATA (SYMBOL_NAME (obj)), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4932 SCHARS (SYMBOL_NAME (obj))); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4933 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4934 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4935 case Lisp_Misc: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4936 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4937 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4938 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4939 case Lisp_String: |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4940 hash = sxhash_string (SDATA (obj), SCHARS (obj)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4941 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4942 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4943 /* This can be everything from a vector to an overlay. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4944 case Lisp_Vectorlike: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4945 if (VECTORP (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4946 /* 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
|
4947 they are `eq', except for strings and bit-vectors. In |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4948 Emacs, this works differently. We have to compare element |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4949 by element. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4950 hash = sxhash_vector (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4951 else if (BOOL_VECTOR_P (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4952 hash = sxhash_bool_vector (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4953 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4954 /* 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
|
4955 address as hash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4956 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4957 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4958 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4959 case Lisp_Cons: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4960 hash = sxhash_list (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4961 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4962 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4963 case Lisp_Float: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4964 { |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4965 unsigned char *p = (unsigned char *) &XFLOAT_DATA (obj); |
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4966 unsigned char *e = p + sizeof XFLOAT_DATA (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4967 for (hash = 0; p < e; ++p) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4968 hash = SXHASH_COMBINE (hash, *p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4969 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4970 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4971 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4972 default: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4973 abort (); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4974 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4975 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4976 return hash & VALMASK; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4977 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4978 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4979 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4980 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4981 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4982 Lisp Interface |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4983 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4984 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4985 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4986 DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4987 doc: /* Compute a hash code for OBJ and return it as integer. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4988 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4989 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4990 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4991 unsigned hash = sxhash (obj, 0);; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4992 return make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4993 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4994 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4995 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4996 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4997 doc: /* Create and return a new hash table. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4998 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4999 Arguments are specified as keyword/argument pairs. The following |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5000 arguments are defined: |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5001 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5002 :test TEST -- TEST must be a symbol that specifies how to compare |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5003 keys. Default is `eql'. Predefined are the tests `eq', `eql', and |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5004 `equal'. User-supplied test and hash functions can be specified via |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5005 `define-hash-table-test'. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5006 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5007 :size SIZE -- A hint as to how many elements will be put in the table. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5008 Default is 65. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5009 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5010 :rehash-size REHASH-SIZE - Indicates how to expand the table when it |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5011 fills up. If REHASH-SIZE is an integer, add that many space. If it |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5012 is a float, it must be > 1.0, and the new size is computed by |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5013 multiplying the old size with that factor. Default is 1.5. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5014 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5015 :rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5016 Resize the hash table when ratio of the number of entries in the |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5017 table. Default is 0.8. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5018 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5019 :weakness WEAK -- WEAK must be one of nil, t, `key', `value', |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5020 `key-or-value', or `key-and-value'. If WEAK is not nil, the table |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5021 returned is a weak table. Key/value pairs are removed from a weak |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5022 hash table when there are no non-weak references pointing to their |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5023 key, value, one of key or value, or both key and value, depending on |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5024 WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK |
40132
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
5025 is nil. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
5026 |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
5027 usage: (make-hash-table &rest KEYWORD-ARGS) */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5028 (nargs, args) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5029 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5030 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5031 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5032 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5033 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5034 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5035 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5036 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5037 /* 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
|
5038 have been consumed. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5039 used = (char *) alloca (nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5040 bzero (used, nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5041 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5042 /* See if there's a `:test TEST' among the arguments. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5043 i = get_key_arg (QCtest, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5044 test = i < 0 ? Qeql : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5045 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5046 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5047 /* See if it is a user-defined test. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5048 Lisp_Object prop; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5049 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5050 prop = Fget (test, Qhash_table_test); |
40734
95dd892ad5e3
(Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
5051 if (!CONSP (prop) || !CONSP (XCDR (prop))) |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5052 Fsignal (Qerror, list2 (build_string ("Invalid hash table test"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5053 test)); |
40734
95dd892ad5e3
(Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
5054 user_test = XCAR (prop); |
95dd892ad5e3
(Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
5055 user_hash = XCAR (XCDR (prop)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5056 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5057 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5058 user_test = user_hash = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5059 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5060 /* See if there's a `:size SIZE' argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5061 i = get_key_arg (QCsize, nargs, args, used); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5062 size = i < 0 ? Qnil : args[i]; |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5063 if (NILP (size)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5064 size = make_number (DEFAULT_HASH_SIZE); |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5065 else if (!INTEGERP (size) || XINT (size) < 0) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5066 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5067 list2 (build_string ("Invalid hash table size"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5068 size)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5069 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5070 /* Look for `:rehash-size SIZE'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5071 i = get_key_arg (QCrehash_size, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5072 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
|
5073 if (!NUMBERP (rehash_size) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5074 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5075 || XFLOATINT (rehash_size) <= 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5076 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5077 list2 (build_string ("Invalid hash table rehash size"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5078 rehash_size)); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5079 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5080 /* Look for `:rehash-threshold THRESHOLD'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5081 i = get_key_arg (QCrehash_threshold, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5082 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
|
5083 if (!FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5084 || XFLOATINT (rehash_threshold) <= 0.0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5085 || XFLOATINT (rehash_threshold) > 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5086 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5087 list2 (build_string ("Invalid hash table rehash threshold"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5088 rehash_threshold)); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5089 |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5090 /* Look for `:weakness WEAK'. */ |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5091 i = get_key_arg (QCweakness, nargs, args, used); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5092 weak = i < 0 ? Qnil : args[i]; |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5093 if (EQ (weak, Qt)) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5094 weak = Qkey_and_value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5095 if (!NILP (weak) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5096 && !EQ (weak, Qkey) |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5097 && !EQ (weak, Qvalue) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5098 && !EQ (weak, Qkey_or_value) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5099 && !EQ (weak, Qkey_and_value)) |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5100 Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5101 weak)); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5102 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5103 /* 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
|
5104 for (i = 0; i < nargs; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5105 if (!used[i]) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5106 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5107 list2 (build_string ("Invalid argument list"), args[i])); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5108 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5109 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
|
5110 user_test, user_hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5111 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5112 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5113 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5114 DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5115 doc: /* Return a copy of hash table TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5116 (table) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5117 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5118 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5119 return copy_hash_table (check_hash_table (table)); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5120 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5121 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5122 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5123 DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5124 doc: /* Return the number of elements in TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5125 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5126 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5127 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5128 return check_hash_table (table)->count; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5129 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5130 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5131 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5132 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5133 Shash_table_rehash_size, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5134 doc: /* Return the current rehash size of TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5135 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5136 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5137 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5138 return check_hash_table (table)->rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5139 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5140 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5141 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5142 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5143 Shash_table_rehash_threshold, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5144 doc: /* Return the current rehash threshold of TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5145 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5146 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5147 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5148 return check_hash_table (table)->rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5149 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5150 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5151 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5152 DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5153 doc: /* Return the size of TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5154 The size can be used as an argument to `make-hash-table' to create |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5155 a hash table than can hold as many elements of TABLE holds |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5156 without need for resizing. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5157 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5158 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5159 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5160 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5161 return make_number (HASH_TABLE_SIZE (h)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5162 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5163 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5164 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5165 DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5166 doc: /* Return the test TABLE uses. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5167 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5168 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5169 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5170 return check_hash_table (table)->test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5171 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5172 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5173 |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5174 DEFUN ("hash-table-weakness", Fhash_table_weakness, Shash_table_weakness, |
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5175 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5176 doc: /* Return the weakness of TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5177 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5178 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5179 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5180 return check_hash_table (table)->weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5181 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5182 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5183 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5184 DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5185 doc: /* Return t if OBJ is a Lisp hash table object. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5186 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5187 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5188 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5189 return HASH_TABLE_P (obj) ? Qt : Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5190 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5191 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5192 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5193 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5194 doc: /* Clear hash table TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5195 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5196 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5197 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5198 hash_clear (check_hash_table (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5199 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5200 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5201 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5202 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5203 DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5204 doc: /* Look up KEY in TABLE and return its associated value. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5205 If KEY is not found, return DFLT which defaults to nil. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5206 (key, table, dflt) |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
25709
diff
changeset
|
5207 Lisp_Object key, table, dflt; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5208 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5209 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5210 int i = hash_lookup (h, key, NULL); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5211 return i >= 0 ? HASH_VALUE (h, i) : dflt; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5212 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5213 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5214 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5215 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5216 doc: /* Associate KEY with VALUE in hash table TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5217 If KEY is already present in table, replace its current value with |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5218 VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5219 (key, value, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
5220 Lisp_Object key, value, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5221 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5222 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5223 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5224 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5225 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5226 i = hash_lookup (h, key, &hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5227 if (i >= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5228 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5229 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5230 hash_put (h, key, value, hash); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5231 |
29991
fff5fd809d11
(Fputhash): Return `value' rather than nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29979
diff
changeset
|
5232 return value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5233 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5234 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5235 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5236 DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5237 doc: /* Remove KEY from TABLE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5238 (key, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
5239 Lisp_Object key, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5240 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5241 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5242 hash_remove (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5243 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5244 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5245 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5246 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5247 DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5248 doc: /* Call FUNCTION for all entries in hash table TABLE. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5249 FUNCTION is called with 2 arguments KEY and VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5250 (function, table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5251 Lisp_Object function, table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5252 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5253 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5254 Lisp_Object args[3]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5255 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5256 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5257 for (i = 0; i < HASH_TABLE_SIZE (h); ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5258 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5259 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5260 args[0] = function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5261 args[1] = HASH_KEY (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5262 args[2] = HASH_VALUE (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5263 Ffuncall (3, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5264 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5265 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5266 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5267 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5268 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5269 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5270 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5271 Sdefine_hash_table_test, 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5272 doc: /* Define a new hash table test with name NAME, a symbol. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5273 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5274 In hash tables created with NAME specified as test, use TEST to |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5275 compare keys, and HASH for computing hash codes of keys. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5276 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5277 TEST must be a function taking two arguments and returning non-nil if |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5278 both arguments are the same. HASH must be a function taking one |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5279 argument and return an integer that is the hash code of the argument. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5280 Hash code computation should use the whole value range of integers, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5281 including negative integers. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5282 (name, test, hash) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5283 Lisp_Object name, test, hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5284 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5285 return Fput (name, Qhash_table_test, list2 (test, hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5286 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5287 |
28965 | 5288 |
34050 | 5289 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5290 /************************************************************************ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5291 MD5 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5292 ************************************************************************/ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5293 |
34050 | 5294 #include "md5.h" |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5295 #include "coding.h" |
34050 | 5296 |
5297 DEFUN ("md5", Fmd5, Smd5, 1, 5, 0, | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5298 doc: /* Return MD5 message digest of OBJECT, a buffer or string. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5299 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5300 A message digest is a cryptographic checksum of a document, and the |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5301 algorithm to calculate it is defined in RFC 1321. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5302 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5303 The two optional arguments START and END are character positions |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5304 specifying for which part of OBJECT the message digest should be |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5305 computed. If nil or omitted, the digest is computed for the whole |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5306 OBJECT. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5307 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5308 The MD5 message digest is computed from the result of encoding the |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5309 text in a coding system, not directly from the internal Emacs form of |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5310 the text. The optional fourth argument CODING-SYSTEM specifies which |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5311 coding system to encode the text with. It should be the same coding |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5312 system that you used or will use when actually writing the text into a |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5313 file. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5314 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5315 If CODING-SYSTEM is nil or omitted, the default depends on OBJECT. If |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5316 OBJECT is a buffer, the default for CODING-SYSTEM is whatever coding |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5317 system would be chosen by default for writing this text into a file. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5318 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5319 If OBJECT is a string, the most preferred coding system (see the |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5320 command `prefer-coding-system') is used. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5321 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5322 If NOERROR is non-nil, silently assume the `raw-text' coding if the |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5323 guesswork fails. Normally, an error is signaled in such case. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5324 (object, start, end, coding_system, noerror) |
34050 | 5325 Lisp_Object object, start, end, coding_system, noerror; |
5326 { | |
5327 unsigned char digest[16]; | |
5328 unsigned char value[33]; | |
5329 int i; | |
5330 int size; | |
5331 int size_byte = 0; | |
5332 int start_char = 0, end_char = 0; | |
5333 int start_byte = 0, end_byte = 0; | |
5334 register int b, e; | |
5335 register struct buffer *bp; | |
5336 int temp; | |
5337 | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5338 if (STRINGP (object)) |
34050 | 5339 { |
5340 if (NILP (coding_system)) | |
5341 { | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5342 /* Decide the coding-system to encode the data with. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5343 |
34050 | 5344 if (STRING_MULTIBYTE (object)) |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5345 /* use default, we can't guess correct value */ |
39581
6d9fa06012a6
Use SYMBOL_VALUE/SET_SYMBOL_VALUE macros instead of accessing
Gerd Moellmann <gerd@gnu.org>
parents:
39072
diff
changeset
|
5346 coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list)); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5347 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5348 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5349 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5350 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5351 if (NILP (Fcoding_system_p (coding_system))) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5352 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5353 /* Invalid coding system. */ |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5354 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5355 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5356 coding_system = Qraw_text; |
34050 | 5357 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5358 while (1) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5359 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); |
34050 | 5360 } |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5361 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5362 if (STRING_MULTIBYTE (object)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5363 object = code_convert_string1 (object, coding_system, Qnil, 1); |
34050 | 5364 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
5365 size = SCHARS (object); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
5366 size_byte = SBYTES (object); |
34050 | 5367 |
5368 if (!NILP (start)) | |
5369 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5370 CHECK_NUMBER (start); |
34050 | 5371 |
5372 start_char = XINT (start); | |
5373 | |
5374 if (start_char < 0) | |
5375 start_char += size; | |
5376 | |
5377 start_byte = string_char_to_byte (object, start_char); | |
5378 } | |
5379 | |
5380 if (NILP (end)) | |
5381 { | |
5382 end_char = size; | |
5383 end_byte = size_byte; | |
5384 } | |
5385 else | |
5386 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5387 CHECK_NUMBER (end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5388 |
34050 | 5389 end_char = XINT (end); |
5390 | |
5391 if (end_char < 0) | |
5392 end_char += size; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5393 |
34050 | 5394 end_byte = string_char_to_byte (object, end_char); |
5395 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5396 |
34050 | 5397 if (!(0 <= start_char && start_char <= end_char && end_char <= size)) |
5398 args_out_of_range_3 (object, make_number (start_char), | |
5399 make_number (end_char)); | |
5400 } | |
5401 else | |
5402 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5403 CHECK_BUFFER (object); |
34050 | 5404 |
5405 bp = XBUFFER (object); | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5406 |
34050 | 5407 if (NILP (start)) |
5408 b = BUF_BEGV (bp); | |
5409 else | |
5410 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5411 CHECK_NUMBER_COERCE_MARKER (start); |
34050 | 5412 b = XINT (start); |
5413 } | |
5414 | |
5415 if (NILP (end)) | |
5416 e = BUF_ZV (bp); | |
5417 else | |
5418 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5419 CHECK_NUMBER_COERCE_MARKER (end); |
34050 | 5420 e = XINT (end); |
5421 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5422 |
34050 | 5423 if (b > e) |
5424 temp = b, b = e, e = temp; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5425 |
34050 | 5426 if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp))) |
5427 args_out_of_range (start, end); | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5428 |
34050 | 5429 if (NILP (coding_system)) |
5430 { | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5431 /* Decide the coding-system to encode the data with. |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5432 See fileio.c:Fwrite-region */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5433 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5434 if (!NILP (Vcoding_system_for_write)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5435 coding_system = Vcoding_system_for_write; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5436 else |
34050 | 5437 { |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5438 int force_raw_text = 0; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5439 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5440 coding_system = XBUFFER (object)->buffer_file_coding_system; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5441 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5442 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5443 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5444 coding_system = Qnil; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5445 if (NILP (current_buffer->enable_multibyte_characters)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5446 force_raw_text = 1; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5447 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5448 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5449 if (NILP (coding_system) && !NILP (Fbuffer_file_name(object))) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5450 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5451 /* Check file-coding-system-alist. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5452 Lisp_Object args[4], val; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5453 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5454 args[0] = Qwrite_region; args[1] = start; args[2] = end; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5455 args[3] = Fbuffer_file_name(object); |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5456 val = Ffind_operation_coding_system (4, args); |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5457 if (CONSP (val) && !NILP (XCDR (val))) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5458 coding_system = XCDR (val); |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5459 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5460 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5461 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5462 && !NILP (XBUFFER (object)->buffer_file_coding_system)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5463 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5464 /* If we still have not decided a coding system, use the |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5465 default value of buffer-file-coding-system. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5466 coding_system = XBUFFER (object)->buffer_file_coding_system; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5467 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5468 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5469 if (!force_raw_text |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5470 && !NILP (Ffboundp (Vselect_safe_coding_system_function))) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5471 /* Confirm that VAL can surely encode the current region. */ |
45629
6adda7388fcc
(md5): Pass FILE arg to Vselect_safe_coding_system_function.
Richard M. Stallman <rms@gnu.org>
parents:
45401
diff
changeset
|
5472 coding_system = call4 (Vselect_safe_coding_system_function, |
34153
f493b32a1a91
(Fmd5): Pass lisp objects, not integers, to call3.
Ken Raeburn <raeburn@raeburn.org>
parents:
34106
diff
changeset
|
5473 make_number (b), make_number (e), |
45629
6adda7388fcc
(md5): Pass FILE arg to Vselect_safe_coding_system_function.
Richard M. Stallman <rms@gnu.org>
parents:
45401
diff
changeset
|
5474 coding_system, Qnil); |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5475 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5476 if (force_raw_text) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5477 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5478 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5479 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5480 if (NILP (Fcoding_system_p (coding_system))) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5481 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5482 /* Invalid coding system. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5483 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5484 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5485 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5486 else |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5487 while (1) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5488 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); |
34050 | 5489 } |
5490 } | |
5491 | |
5492 object = make_buffer_string (b, e, 0); | |
5493 | |
5494 if (STRING_MULTIBYTE (object)) | |
5495 object = code_convert_string1 (object, coding_system, Qnil, 1); | |
5496 } | |
5497 | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5498 md5_buffer (SDATA (object) + start_byte, |
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5499 SBYTES (object) - (size_byte - end_byte), |
34050 | 5500 digest); |
5501 | |
5502 for (i = 0; i < 16; i++) | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5503 sprintf (&value[2 * i], "%02x", digest[i]); |
34050 | 5504 value[32] = '\0'; |
5505 | |
5506 return make_string (value, 32); | |
5507 } | |
5508 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5509 |
21514 | 5510 void |
211 | 5511 syms_of_fns () |
5512 { | |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5513 /* Hash table stuff. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5514 Qhash_table_p = intern ("hash-table-p"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5515 staticpro (&Qhash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5516 Qeq = intern ("eq"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5517 staticpro (&Qeq); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5518 Qeql = intern ("eql"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5519 staticpro (&Qeql); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5520 Qequal = intern ("equal"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5521 staticpro (&Qequal); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5522 QCtest = intern (":test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5523 staticpro (&QCtest); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5524 QCsize = intern (":size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5525 staticpro (&QCsize); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5526 QCrehash_size = intern (":rehash-size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5527 staticpro (&QCrehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5528 QCrehash_threshold = intern (":rehash-threshold"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5529 staticpro (&QCrehash_threshold); |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5530 QCweakness = intern (":weakness"); |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5531 staticpro (&QCweakness); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5532 Qkey = intern ("key"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5533 staticpro (&Qkey); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5534 Qvalue = intern ("value"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5535 staticpro (&Qvalue); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5536 Qhash_table_test = intern ("hash-table-test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5537 staticpro (&Qhash_table_test); |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5538 Qkey_or_value = intern ("key-or-value"); |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5539 staticpro (&Qkey_or_value); |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5540 Qkey_and_value = intern ("key-and-value"); |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5541 staticpro (&Qkey_and_value); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5542 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5543 defsubr (&Ssxhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5544 defsubr (&Smake_hash_table); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5545 defsubr (&Scopy_hash_table); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5546 defsubr (&Shash_table_count); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5547 defsubr (&Shash_table_rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5548 defsubr (&Shash_table_rehash_threshold); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5549 defsubr (&Shash_table_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5550 defsubr (&Shash_table_test); |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5551 defsubr (&Shash_table_weakness); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5552 defsubr (&Shash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5553 defsubr (&Sclrhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5554 defsubr (&Sgethash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5555 defsubr (&Sputhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5556 defsubr (&Sremhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5557 defsubr (&Smaphash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5558 defsubr (&Sdefine_hash_table_test); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5559 |
211 | 5560 Qstring_lessp = intern ("string-lessp"); |
5561 staticpro (&Qstring_lessp); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5562 Qprovide = intern ("provide"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5563 staticpro (&Qprovide); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5564 Qrequire = intern ("require"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5565 staticpro (&Qrequire); |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
5566 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
|
5567 staticpro (&Qyes_or_no_p_history); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
5568 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
|
5569 staticpro (&Qcursor_in_echo_area); |
20004 | 5570 Qwidget_type = intern ("widget-type"); |
5571 staticpro (&Qwidget_type); | |
211 | 5572 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5573 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
|
5574 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
|
5575 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5576 require_nesting_list = Qnil; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5577 staticpro (&require_nesting_list); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5578 |
14486
3c4ba112108e
(syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents:
14456
diff
changeset
|
5579 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
|
5580 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5581 DEFVAR_LISP ("features", &Vfeatures, |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5582 doc: /* A list of symbols which are the features of the executing emacs. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5583 Used by `featurep' and `require', and altered by `provide'. */); |
211 | 5584 Vfeatures = Qnil; |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5585 Qsubfeatures = intern ("subfeatures"); |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5586 staticpro (&Qsubfeatures); |
211 | 5587 |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5588 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5589 Qcodeset = intern ("codeset"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5590 staticpro (&Qcodeset); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5591 Qdays = intern ("days"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5592 staticpro (&Qdays); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5593 Qmonths = intern ("months"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5594 staticpro (&Qmonths); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5595 Qpaper = intern ("paper"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5596 staticpro (&Qpaper); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5597 #endif /* HAVE_LANGINFO_CODESET */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5598 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5599 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box, |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5600 doc: /* *Non-nil means mouse commands use dialog boxes to ask questions. |
44712 | 5601 This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5602 invoked by mouse clicks and mouse menu items. */); |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
5603 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
|
5604 |
211 | 5605 defsubr (&Sidentity); |
5606 defsubr (&Srandom); | |
5607 defsubr (&Slength); | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
5608 defsubr (&Ssafe_length); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
5609 defsubr (&Sstring_bytes); |
211 | 5610 defsubr (&Sstring_equal); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
5611 defsubr (&Scompare_strings); |
211 | 5612 defsubr (&Sstring_lessp); |
5613 defsubr (&Sappend); | |
5614 defsubr (&Sconcat); | |
5615 defsubr (&Svconcat); | |
5616 defsubr (&Scopy_sequence); | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5617 defsubr (&Sstring_make_multibyte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5618 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
|
5619 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
|
5620 defsubr (&Sstring_as_unibyte); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
5621 defsubr (&Sstring_to_multibyte); |
211 | 5622 defsubr (&Scopy_alist); |
5623 defsubr (&Ssubstring); | |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5624 defsubr (&Ssubstring_no_properties); |
211 | 5625 defsubr (&Snthcdr); |
5626 defsubr (&Snth); | |
5627 defsubr (&Selt); | |
5628 defsubr (&Smember); | |
5629 defsubr (&Smemq); | |
5630 defsubr (&Sassq); | |
5631 defsubr (&Sassoc); | |
5632 defsubr (&Srassq); | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
5633 defsubr (&Srassoc); |
211 | 5634 defsubr (&Sdelq); |
414 | 5635 defsubr (&Sdelete); |
211 | 5636 defsubr (&Snreverse); |
5637 defsubr (&Sreverse); | |
5638 defsubr (&Ssort); | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5639 defsubr (&Splist_get); |
211 | 5640 defsubr (&Sget); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5641 defsubr (&Splist_put); |
211 | 5642 defsubr (&Sput); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5643 defsubr (&Slax_plist_get); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5644 defsubr (&Slax_plist_put); |
211 | 5645 defsubr (&Sequal); |
5646 defsubr (&Sfillarray); | |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
5647 defsubr (&Schar_table_subtype); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5648 defsubr (&Schar_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5649 defsubr (&Sset_char_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5650 defsubr (&Schar_table_extra_slot); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5651 defsubr (&Sset_char_table_extra_slot); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
5652 defsubr (&Schar_table_range); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5653 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
|
5654 defsubr (&Sset_char_table_default); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
5655 defsubr (&Soptimize_char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5656 defsubr (&Smap_char_table); |
211 | 5657 defsubr (&Snconc); |
5658 defsubr (&Smapcar); | |
28666 | 5659 defsubr (&Smapc); |
211 | 5660 defsubr (&Smapconcat); |
5661 defsubr (&Sy_or_n_p); | |
5662 defsubr (&Syes_or_no_p); | |
5663 defsubr (&Sload_average); | |
5664 defsubr (&Sfeaturep); | |
5665 defsubr (&Srequire); | |
5666 defsubr (&Sprovide); | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
5667 defsubr (&Splist_member); |
20004 | 5668 defsubr (&Swidget_put); |
5669 defsubr (&Swidget_get); | |
5670 defsubr (&Swidget_apply); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5671 defsubr (&Sbase64_encode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5672 defsubr (&Sbase64_decode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5673 defsubr (&Sbase64_encode_string); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5674 defsubr (&Sbase64_decode_string); |
34050 | 5675 defsubr (&Smd5); |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5676 defsubr (&Slanginfo); |
211 | 5677 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5678 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5679 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5680 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5681 init_fns () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5682 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5683 Vweak_hash_tables = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5684 } |