Mercurial > emacs
annotate src/fns.c @ 66867:87c432b77d3e
*** empty log message ***
author | Jay Belanger <jay.p.belanger@gmail.com> |
---|---|
date | Mon, 14 Nov 2005 20:21:40 +0000 |
parents | bd4a75b12109 |
children | 6f5564740da6 732c5740ca8f |
rev | line source |
---|---|
211 | 1 /* Random utility Lisp functions. |
64770
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64484
diff
changeset
|
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, |
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64484
diff
changeset
|
3 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64484
diff
changeset
|
4 2005 Free Software Foundation, Inc. |
211 | 5 |
6 This file is part of GNU Emacs. | |
7 | |
8 GNU Emacs is free software; you can redistribute it and/or modify | |
9 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
|
10 the Free Software Foundation; either version 2, or (at your option) |
211 | 11 any later version. |
12 | |
13 GNU Emacs is distributed in the hope that it will be useful, | |
14 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 GNU General Public License for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
19 along with GNU Emacs; see the file COPYING. If not, write to | |
64084 | 20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
21 Boston, MA 02110-1301, USA. */ | |
211 | 22 |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4616
diff
changeset
|
23 #include <config.h> |
211 | 24 |
21514 | 25 #ifdef HAVE_UNISTD_H |
26 #include <unistd.h> | |
27 #endif | |
21841
12c75f0ef578
Include <time.h> for time.
Andreas Schwab <schwab@suse.de>
parents:
21810
diff
changeset
|
28 #include <time.h> |
21514 | 29 |
59146
9bde7721ad0f
* dispextern.h: Change HAVE_CARBON to MAC_OS.
Steven Tamm <steventamm@mac.com>
parents:
58623
diff
changeset
|
30 #ifndef MAC_OS |
9bde7721ad0f
* dispextern.h: Change HAVE_CARBON to MAC_OS.
Steven Tamm <steventamm@mac.com>
parents:
58623
diff
changeset
|
31 /* On Mac OS, defining this conflicts with precompiled headers. */ |
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
|
32 |
211 | 33 /* Note on some machines this defines `vector' as a typedef, |
34 so make sure we don't use that name in this file. */ | |
35 #undef vector | |
36 #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
|
37 |
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 #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
|
39 |
211 | 40 #include "lisp.h" |
41 #include "commands.h" | |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
42 #include "charset.h" |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
43 #include "coding.h" |
211 | 44 #include "buffer.h" |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
45 #include "keyboard.h" |
39697
0b986bb45526
Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39682
diff
changeset
|
46 #include "keymap.h" |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
47 #include "intervals.h" |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
48 #include "frame.h" |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
49 #include "window.h" |
37319 | 50 #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
|
51 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS) |
21514 | 52 #include "xterm.h" |
53 #endif | |
211 | 54 |
12062 | 55 #ifndef NULL |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
56 #define NULL ((POINTER_TYPE *)0) |
12062 | 57 #endif |
58 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
59 /* 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
|
60 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
|
61 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
|
62 |
53189
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
63 /* Nonzero enables use of a file dialog for file name |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
64 questions asked by mouse commands. */ |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
65 int use_file_dialog; |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
66 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
67 extern int minibuffer_auto_raise; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
68 extern Lisp_Object minibuf_window; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
69 extern Lisp_Object Vlocale_coding_system; |
61622
aef105b11011
(Vloads_in_progress): Remove extern.
Lute Kamstra <lute@gnu.org>
parents:
61433
diff
changeset
|
70 extern int load_in_progress; |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
71 |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
72 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
|
73 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
|
74 Lisp_Object Qcursor_in_echo_area; |
20004 | 75 Lisp_Object Qwidget_type; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
76 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; |
211 | 77 |
23051
18ed8d6b11e5
(Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents:
22853
diff
changeset
|
78 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
|
79 |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
80 static int internal_equal P_ ((Lisp_Object , Lisp_Object, int, int)); |
21580
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
81 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
82 extern long get_random (); |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
83 extern void seed_random P_ ((long)); |
21580
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
84 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
85 #ifndef HAVE_UNISTD_H |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
86 extern long time (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
87 #endif |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
88 |
211 | 89 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
41006 | 90 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
|
91 (arg) |
211 | 92 Lisp_Object arg; |
93 { | |
94 return arg; | |
95 } | |
96 | |
97 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
|
98 doc: /* Return a pseudo-random number. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
99 All integers representable in Lisp are equally likely. |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
100 On most systems, this is 29 bits' worth. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
101 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
|
102 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
|
103 (n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
104 Lisp_Object n; |
211 | 105 { |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
106 EMACS_INT val; |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
107 Lisp_Object lispy_val; |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
108 unsigned long denominator; |
211 | 109 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
110 if (EQ (n, Qt)) |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
111 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
|
112 if (NATNUMP (n) && XFASTINT (n) != 0) |
211 | 113 { |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
114 /* 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
|
115 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
|
116 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
|
117 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
|
118 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
|
119 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
|
120 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
|
121 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
122 do |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
123 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
|
124 while (val >= XFASTINT (n)); |
211 | 125 } |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
126 else |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
127 val = get_random (); |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
128 XSETINT (lispy_val, val); |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
129 return lispy_val; |
211 | 130 } |
131 | |
132 /* Random data-structure functions */ | |
133 | |
134 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
|
135 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
|
136 A byte-code function object is also allowed. |
47762 | 137 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
|
138 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
|
139 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
|
140 (sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
141 register Lisp_Object sequence; |
211 | 142 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
143 register Lisp_Object val; |
211 | 144 register int i; |
145 | |
146 retry: | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
147 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
|
148 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
|
149 else if (VECTORP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
150 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
|
151 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
|
152 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
|
153 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
|
154 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
|
155 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
|
156 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
|
157 else if (COMPILEDP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
158 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
|
159 else if (CONSP (sequence)) |
211 | 160 { |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
161 i = 0; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
162 while (CONSP (sequence)) |
211 | 163 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
164 sequence = XCDR (sequence); |
26256
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 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
167 if (!CONSP (sequence)) |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
168 break; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
169 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
170 sequence = XCDR (sequence); |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
171 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
172 QUIT; |
211 | 173 } |
174 | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
175 if (!NILP (sequence)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
176 wrong_type_argument (Qlistp, sequence); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
177 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
178 val = make_number (i); |
211 | 179 } |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
180 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
|
181 XSETFASTINT (val, 0); |
211 | 182 else |
183 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
184 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 185 goto retry; |
186 } | |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
187 return val; |
211 | 188 } |
189 | |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
190 /* This does not check for quits. That is safe since it must terminate. */ |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
191 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
192 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
|
193 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
|
194 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
|
195 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
|
196 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
|
197 (list) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
198 Lisp_Object list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
199 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
200 Lisp_Object tail, halftail, length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
201 int len = 0; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
202 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
203 /* halftail is used to detect circular lists. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
204 halftail = list; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
205 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
206 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
207 if (EQ (tail, halftail) && len != 0) |
12618
60c4c0fee545
(Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents:
12466
diff
changeset
|
208 break; |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
209 len++; |
13344
30e17254a280
(Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents:
13277
diff
changeset
|
210 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
|
211 halftail = XCDR (halftail); |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
212 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
213 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
214 XSETINT (length, len); |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
215 return length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
216 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
217 |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
218 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
|
219 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
|
220 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
|
221 (string) |
20881
fd35cf0efd94
(Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents:
20880
diff
changeset
|
222 Lisp_Object string; |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
223 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
224 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
|
225 return make_number (SBYTES (string)); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
226 } |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
227 |
211 | 228 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
|
229 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
|
230 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
|
231 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
|
232 (s1, s2) |
211 | 233 register Lisp_Object s1, s2; |
234 { | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
235 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
236 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
|
237 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
238 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
|
239 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
240 CHECK_STRING (s2); |
211 | 241 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
242 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
|
243 || 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
|
244 || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1))) |
211 | 245 return Qnil; |
246 return Qt; | |
247 } | |
248 | |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
249 DEFUN ("compare-strings", Fcompare_strings, |
21673
8a32bf93da04
(Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents:
21671
diff
changeset
|
250 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
|
251 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
|
252 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
|
253 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
|
254 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
|
255 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
256 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
|
257 Unibyte strings are converted to multibyte for comparison. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
258 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
259 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
|
260 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
|
261 - 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
|
262 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
|
263 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
|
264 (str1, start1, end1, str2, start2, end2, ignore_case) |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
265 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
|
266 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
267 register int end1_char, end2_char; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
268 register int i1, i1_byte, i2, i2_byte; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
269 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
270 CHECK_STRING (str1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
271 CHECK_STRING (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
272 if (NILP (start1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
273 start1 = make_number (0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
274 if (NILP (start2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
275 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
|
276 CHECK_NATNUM (start1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
277 CHECK_NATNUM (start2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
278 if (! NILP (end1)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
279 CHECK_NATNUM (end1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
280 if (! NILP (end2)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
281 CHECK_NATNUM (end2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
282 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
283 i1 = XINT (start1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
284 i2 = XINT (start2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
285 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
286 i1_byte = string_char_to_byte (str1, i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
287 i2_byte = string_char_to_byte (str2, i2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
288 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
289 end1_char = SCHARS (str1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
290 if (! NILP (end1) && end1_char > XINT (end1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
291 end1_char = XINT (end1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
292 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
293 end2_char = SCHARS (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
294 if (! NILP (end2) && end2_char > XINT (end2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
295 end2_char = XINT (end2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
296 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
297 while (i1 < end1_char && i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
298 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
299 /* When we find a mismatch, we must compare the |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
300 characters, not just the bytes. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
301 int c1, c2; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
302 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
303 if (STRING_MULTIBYTE (str1)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
304 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
|
305 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
306 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
307 c1 = SREF (str1, i1++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
308 c1 = unibyte_char_to_multibyte (c1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
309 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
310 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
311 if (STRING_MULTIBYTE (str2)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
312 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
|
313 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
314 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
315 c2 = SREF (str2, i2++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
316 c2 = unibyte_char_to_multibyte (c2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
317 } |
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 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
320 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
321 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
322 if (! NILP (ignore_case)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
323 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
324 Lisp_Object 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 tem = Fupcase (make_number (c1)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
327 c1 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
328 tem = Fupcase (make_number (c2)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
329 c2 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
330 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
331 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
332 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
333 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
334 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
335 /* Note that I1 has already been incremented |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
336 past the character that we are comparing; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
337 hence we don't add or subtract 1 here. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
338 if (c1 < c2) |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
339 return make_number (- i1 + XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
340 else |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
341 return make_number (i1 - XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
342 } |
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 if (i1 < end1_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
345 return make_number (i1 - XINT (start1) + 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
346 if (i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
347 return make_number (- i1 + XINT (start1) - 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
348 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
349 return Qt; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
350 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
351 |
211 | 352 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
|
353 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
|
354 Case is significant. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
355 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
|
356 (s1, s2) |
211 | 357 register Lisp_Object s1, s2; |
358 { | |
359 register int end; | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
360 register int i1, i1_byte, i2, i2_byte; |
211 | 361 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
362 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
363 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
|
364 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
365 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
|
366 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
367 CHECK_STRING (s2); |
211 | 368 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
369 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
|
370 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
371 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
|
372 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
|
373 end = SCHARS (s2); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
374 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
375 while (i1 < end) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
376 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
377 /* 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
|
378 characters, not just the bytes. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
379 int c1, c2; |
211 | 380 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
381 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
|
382 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
|
383 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
384 if (c1 != c2) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
385 return c1 < c2 ? Qt : Qnil; |
211 | 386 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
387 return i1 < SCHARS (s2) ? Qt : Qnil; |
211 | 388 } |
389 | |
390 static Lisp_Object concat (); | |
391 | |
392 /* ARGSUSED */ | |
393 Lisp_Object | |
394 concat2 (s1, s2) | |
395 Lisp_Object s1, s2; | |
396 { | |
397 #ifdef NO_ARG_ARRAY | |
398 Lisp_Object args[2]; | |
399 args[0] = s1; | |
400 args[1] = s2; | |
401 return concat (2, args, Lisp_String, 0); | |
402 #else | |
403 return concat (2, &s1, Lisp_String, 0); | |
404 #endif /* NO_ARG_ARRAY */ | |
405 } | |
406 | |
8966
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
407 /* ARGSUSED */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
408 Lisp_Object |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
409 concat3 (s1, s2, s3) |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
410 Lisp_Object s1, s2, s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
411 { |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
412 #ifdef NO_ARG_ARRAY |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
413 Lisp_Object args[3]; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
414 args[0] = s1; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
415 args[1] = s2; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
416 args[2] = s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
417 return concat (3, args, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
418 #else |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
419 return concat (3, &s1, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
420 #endif /* NO_ARG_ARRAY */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
421 } |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
422 |
211 | 423 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
|
424 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
|
425 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
|
426 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
|
427 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
|
428 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
|
429 (nargs, args) |
211 | 430 int nargs; |
431 Lisp_Object *args; | |
432 { | |
433 return concat (nargs, args, Lisp_Cons, 1); | |
434 } | |
435 | |
436 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
|
437 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
|
438 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
|
439 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
|
440 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
|
441 (nargs, args) |
211 | 442 int nargs; |
443 Lisp_Object *args; | |
444 { | |
445 return concat (nargs, args, Lisp_String, 0); | |
446 } | |
447 | |
448 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
|
449 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
|
450 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
|
451 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
|
452 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
|
453 (nargs, args) |
211 | 454 int nargs; |
455 Lisp_Object *args; | |
456 { | |
10006
402c87cbc4fa
(Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9965
diff
changeset
|
457 return concat (nargs, args, Lisp_Vectorlike, 0); |
211 | 458 } |
459 | |
47762 | 460 /* 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
|
461 nested sub char table are not copied. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
462 static Lisp_Object |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
463 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
|
464 Lisp_Object arg; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
465 { |
61735
76a2f6423902
(copy_sub_char_table): Explicitly copy the default value
Kenichi Handa <handa@m17n.org>
parents:
61723
diff
changeset
|
466 Lisp_Object copy = make_sub_char_table (Qnil); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
467 int i; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
468 |
61735
76a2f6423902
(copy_sub_char_table): Explicitly copy the default value
Kenichi Handa <handa@m17n.org>
parents:
61723
diff
changeset
|
469 XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (arg)->defalt; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
470 /* Copy all the contents. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
471 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
|
472 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
473 /* 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
|
474 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
|
475 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
|
476 XCHAR_TABLE (copy)->contents[i] |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
477 = 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
|
478 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
479 return copy; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
480 } |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
481 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
482 |
211 | 483 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, |
48320 | 484 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
|
485 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
|
486 with the original. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
487 (arg) |
211 | 488 Lisp_Object arg; |
489 { | |
485 | 490 if (NILP (arg)) return arg; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
491 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
492 if (CHAR_TABLE_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
493 { |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
494 int i; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
495 Lisp_Object copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
496 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
497 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
|
498 /* 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
|
499 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
500 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) |
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
501 * sizeof (Lisp_Object))); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
502 |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
503 /* 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
|
504 for multibyte characters. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
505 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
506 i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
507 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
|
508 XCHAR_TABLE (copy)->contents[i] |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
509 = 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
|
510 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
511 return copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
512 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
513 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
514 if (BOOL_VECTOR_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
515 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
516 Lisp_Object val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
517 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
518 = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) |
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
519 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
520 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
521 val = Fmake_bool_vector (Flength (arg), Qnil); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
522 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
|
523 size_in_chars); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
524 return val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
525 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
526 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
527 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) |
211 | 528 arg = wrong_type_argument (Qsequencep, arg); |
529 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); | |
530 } | |
531 | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
532 /* 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
|
533 a string and has text properties to be copied. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
534 struct textprop_rec |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
535 { |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
536 int argnum; /* refer to ARGS (arguments of `concat') */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
537 int from; /* refer to ARGS[argnum] (argument string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
538 int to; /* refer to VAL (the target string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
539 }; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
540 |
211 | 541 static Lisp_Object |
542 concat (nargs, args, target_type, last_special) | |
543 int nargs; | |
544 Lisp_Object *args; | |
545 enum Lisp_Type target_type; | |
546 int last_special; | |
547 { | |
548 Lisp_Object val; | |
549 register Lisp_Object tail; | |
550 register Lisp_Object this; | |
551 int toindex; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
552 int toindex_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
553 register int result_len; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
554 register int result_len_byte; |
211 | 555 register int argnum; |
556 Lisp_Object last_tail; | |
557 Lisp_Object prev; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
558 int some_multibyte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
559 /* 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
|
560 while concatinating each string because the length of resulting |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
561 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
|
562 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
|
563 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
|
564 struct textprop_rec *textprops = NULL; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
565 /* Number of elments in textprops. */ |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
566 int num_textprops = 0; |
58623 | 567 USE_SAFE_ALLOCA; |
211 | 568 |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
569 tail = Qnil; |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
570 |
211 | 571 /* In append, the last arg isn't treated like the others */ |
572 if (last_special && nargs > 0) | |
573 { | |
574 nargs--; | |
575 last_tail = args[nargs]; | |
576 } | |
577 else | |
578 last_tail = Qnil; | |
579 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
580 /* Canonicalize each argument. */ |
211 | 581 for (argnum = 0; argnum < nargs; argnum++) |
582 { | |
583 this = args[argnum]; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
584 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
|
585 || COMPILEDP (this) || BOOL_VECTOR_P (this))) |
211 | 586 { |
587 args[argnum] = wrong_type_argument (Qsequencep, this); | |
588 } | |
589 } | |
590 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
591 /* 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
|
592 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
|
593 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
|
594 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
|
595 result_len_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
596 result_len = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
597 some_multibyte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
598 for (argnum = 0; argnum < nargs; argnum++) |
211 | 599 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
600 int len; |
211 | 601 this = args[argnum]; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
602 len = XFASTINT (Flength (this)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
603 if (target_type == Lisp_String) |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
604 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
605 /* 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
|
606 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
|
607 int i; |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
608 Lisp_Object ch; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
609 int this_len_byte; |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
610 |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
611 if (VECTORP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
612 for (i = 0; i < len; i++) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
613 { |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
614 ch = XVECTOR (this)->contents[i]; |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
615 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
616 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
|
617 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
|
618 result_len_byte += this_len_byte; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
619 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
|
620 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
621 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
622 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
|
623 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
|
624 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
|
625 for (; CONSP (this); this = XCDR (this)) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
626 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
627 ch = XCAR (this); |
19278
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 } |
20639
12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents:
20607
diff
changeset
|
635 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
636 { |
20699
907d8633c8cc
(concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents:
20667
diff
changeset
|
637 if (STRING_MULTIBYTE (this)) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
638 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
639 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
|
640 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
|
641 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
642 else |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
643 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
|
644 SCHARS (this)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
645 } |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
646 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
647 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
648 result_len += len; |
211 | 649 } |
650 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
651 if (! some_multibyte) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
652 result_len_byte = result_len; |
211 | 653 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
654 /* Create the output object. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
655 if (target_type == Lisp_Cons) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
656 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
|
657 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
|
658 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
|
659 else if (some_multibyte) |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
660 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
|
661 else |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
662 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
|
663 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
664 /* 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
|
665 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
|
666 return last_tail; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
667 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
668 /* Copy the contents of the args into the result. */ |
211 | 669 if (CONSP (val)) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
670 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ |
211 | 671 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
672 toindex = 0, toindex_byte = 0; |
211 | 673 |
674 prev = Qnil; | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
675 if (STRINGP (val)) |
58623 | 676 SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
677 |
211 | 678 for (argnum = 0; argnum < nargs; argnum++) |
679 { | |
680 Lisp_Object thislen; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
681 int thisleni = 0; |
16863
591b7a95d7a5
(concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents:
16561
diff
changeset
|
682 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
|
683 register unsigned int thisindex_byte = 0; |
211 | 684 |
685 this = args[argnum]; | |
686 if (!CONSP (this)) | |
687 thislen = Flength (this), thisleni = XINT (thislen); | |
688 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
689 /* 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
|
690 if (STRINGP (this) && STRINGP (val) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
691 && 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
|
692 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
693 int thislen_byte = SBYTES (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
694 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
695 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
|
696 SBYTES (this)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
697 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
698 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
699 textprops[num_textprops].argnum = argnum; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
700 textprops[num_textprops].from = 0; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
701 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
702 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
703 toindex_byte += thislen_byte; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
704 toindex += thisleni; |
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
705 STRING_SET_CHARS (val, SCHARS (val)); |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
706 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
707 /* 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
|
708 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
|
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 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
711 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
712 textprops[num_textprops].argnum = argnum; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
713 textprops[num_textprops].from = 0; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
714 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
715 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
716 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
|
717 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
|
718 SCHARS (this), 0, 1); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
719 toindex += thisleni; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
720 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
721 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
722 /* Copy element by element. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
723 while (1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
724 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
725 register Lisp_Object elt; |
211 | 726 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
727 /* 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
|
728 `this' is exhausted. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
729 if (NILP (this)) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
730 if (CONSP (this)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
731 elt = XCAR (this), this = XCDR (this); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
732 else if (thisindex >= thisleni) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
733 break; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
734 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
735 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
736 int c; |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
737 if (STRING_MULTIBYTE (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
738 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
739 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
740 thisindex, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
741 thisindex_byte); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
742 XSETFASTINT (elt, c); |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
743 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
744 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
745 { |
58265
491080266027
Avoid side-effects inside XSETFASTINT's arguments.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58239
diff
changeset
|
746 XSETFASTINT (elt, SREF (this, thisindex)); thisindex++; |
23152
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
747 if (some_multibyte |
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
748 && (XINT (elt) >= 0240 |
23927
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
749 || (XINT (elt) >= 0200 |
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
750 && ! NILP (Vnonascii_translation_table))) |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
751 && XINT (elt) < 0400) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
752 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
753 c = unibyte_char_to_multibyte (XINT (elt)); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
754 XSETINT (elt, c); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
755 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
756 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
757 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
758 else if (BOOL_VECTOR_P (this)) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
759 { |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
760 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
761 byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR]; |
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
762 if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR))) |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
763 elt = Qt; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
764 else |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
765 elt = Qnil; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
766 thisindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
767 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
768 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
769 elt = XVECTOR (this)->contents[thisindex++]; |
211 | 770 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
771 /* 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
|
772 if (toindex < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
773 { |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
774 XSETCAR (tail, elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
775 prev = tail; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
776 tail = XCDR (tail); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
777 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
778 else if (VECTORP (val)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
779 XVECTOR (val)->contents[toindex++] = elt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
780 else |
211 | 781 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
782 CHECK_NUMBER (elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
783 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
|
784 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
785 if (some_multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
786 toindex_byte |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
787 += 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
|
788 SDATA (val) + toindex_byte); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
789 else |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
790 SSET (val, toindex_byte++, XINT (elt)); |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
791 toindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
792 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
793 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
794 /* 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
|
795 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
|
796 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
797 int c = XINT (elt); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
798 /* P exists as a variable |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
799 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
|
800 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
|
801 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
802 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
|
803 toindex++; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
804 } |
211 | 805 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
806 } |
211 | 807 } |
485 | 808 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
|
809 XSETCDR (prev, last_tail); |
211 | 810 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
811 if (num_textprops > 0) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
812 { |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
813 Lisp_Object props; |
35352
42b56dd8986e
(concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents:
35336
diff
changeset
|
814 int last_to_end = -1; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
815 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
816 for (argnum = 0; argnum < num_textprops; argnum++) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
817 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
818 this = args[textprops[argnum].argnum]; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
819 props = text_property_list (this, |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
820 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
|
821 make_number (SCHARS (this)), |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
822 Qnil); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
823 /* 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
|
824 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
|
825 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
|
826 make_composition_value_copy (props); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
827 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
|
828 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
|
829 last_to_end = textprops[argnum].to + SCHARS (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
830 } |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
831 } |
58623 | 832 |
833 SAFE_FREE (); | |
20004 | 834 return val; |
211 | 835 } |
836 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
837 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
|
838 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
|
839 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
|
840 |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
841 void |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
842 clear_string_char_byte_cache () |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
843 { |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
844 string_char_byte_cache_string = Qnil; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
845 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
846 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
847 /* 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
|
848 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
849 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
850 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
|
851 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
852 int char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
853 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
854 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
855 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
|
856 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
|
857 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
858 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
|
859 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
|
860 best_above_byte = SBYTES (string); |
53742
2b23252ecc55
(string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents:
53681
diff
changeset
|
861 if (best_above == best_above_byte) |
2b23252ecc55
(string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents:
53681
diff
changeset
|
862 return char_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
863 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
864 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
|
865 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
866 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
|
867 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
868 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
|
869 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
|
870 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
871 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
872 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
873 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
|
874 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
|
875 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
876 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
877 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
878 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
|
879 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
880 while (best_below < char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
881 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
882 int c; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
883 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
884 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
|
885 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
886 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
887 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
|
888 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
889 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
890 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
891 while (best_above > char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
892 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
893 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
|
894 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
|
895 unsigned char *p = pend - 1; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
896 int bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
897 |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
898 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
|
899 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
|
900 if (bytes == pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
901 best_above_byte -= bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
902 else if (bytes > pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
903 best_above_byte -= (pend - p); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
904 else |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
905 best_above_byte--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
906 best_above--; |
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 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
909 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
910 } |
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 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
|
913 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
|
914 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
|
915 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
916 return i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
917 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
918 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
919 /* 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
|
920 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
921 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
922 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
|
923 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
924 int byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
925 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
926 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
927 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
|
928 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
|
929 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
930 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
|
931 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
|
932 best_above_byte = SBYTES (string); |
53742
2b23252ecc55
(string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents:
53681
diff
changeset
|
933 if (best_above == best_above_byte) |
2b23252ecc55
(string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents:
53681
diff
changeset
|
934 return byte_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
935 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
936 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
|
937 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
938 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
|
939 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
940 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
|
941 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
|
942 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
943 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
944 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
945 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
|
946 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
|
947 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
948 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
949 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
950 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
|
951 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
952 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
|
953 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
954 int c; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
955 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
956 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
|
957 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
958 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
959 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
|
960 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
961 else |
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 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
|
964 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
965 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
|
966 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
|
967 unsigned char *p = pend - 1; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
968 int bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
969 |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
970 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
|
971 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
|
972 if (bytes == pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
973 best_above_byte -= bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
974 else if (bytes > pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
975 best_above_byte -= (pend - p); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
976 else |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
977 best_above_byte--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
978 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
979 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
980 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
981 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
982 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
983 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
984 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
|
985 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
|
986 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
|
987 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
988 return i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
989 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
990 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
991 /* Convert STRING to a multibyte string. |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
992 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
|
993 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
|
994 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
995 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
996 string_make_multibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
997 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
998 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
999 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1000 int nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1001 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1002 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1003 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1004 if (STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1005 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1006 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1007 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
|
1008 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
|
1009 /* 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
|
1010 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
|
1011 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
|
1012 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1013 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1014 SAFE_ALLOCA (buf, unsigned char *, nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1015 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
|
1016 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1017 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1018 ret = make_multibyte_string (buf, SCHARS (string), nbytes); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
1019 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1020 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1021 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1022 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1023 |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1024 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1025 /* Convert STRING to a multibyte string without changing each |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1026 character codes. Thus, characters 0200 trough 0237 are converted |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1027 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
|
1028 are converted eight-bit-graphic characters. */ |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1029 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1030 Lisp_Object |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1031 string_to_multibyte (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1032 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1033 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1034 unsigned char *buf; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1035 int nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1036 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1037 USE_SAFE_ALLOCA; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1038 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1039 if (STRING_MULTIBYTE (string)) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1040 return string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1041 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1042 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
|
1043 /* 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
|
1044 any more bytes once converted. */ |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1045 if (nbytes == SBYTES (string)) |
49815
2a19e12053a4
(string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents:
49798
diff
changeset
|
1046 return make_multibyte_string (SDATA (string), nbytes, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1047 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1048 SAFE_ALLOCA (buf, unsigned char *, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1049 bcopy (SDATA (string), buf, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1050 str_to_multibyte (buf, nbytes, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1051 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1052 ret = make_multibyte_string (buf, SCHARS (string), nbytes); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
1053 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1054 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1055 return ret; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1056 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1057 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1058 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1059 /* 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
|
1060 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1061 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1062 string_make_unibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1063 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1064 { |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1065 int nchars; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1066 unsigned char *buf; |
56147
6b858fb89033
* fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents:
55481
diff
changeset
|
1067 Lisp_Object ret; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1068 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1069 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1070 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1071 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1072 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1073 nchars = SCHARS (string); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1074 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1075 SAFE_ALLOCA (buf, unsigned char *, nchars); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1076 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
|
1077 1, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1078 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1079 ret = make_unibyte_string (buf, nchars); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
1080 SAFE_FREE (); |
56147
6b858fb89033
* fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents:
55481
diff
changeset
|
1081 |
6b858fb89033
* fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents:
55481
diff
changeset
|
1082 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1083 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1084 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1085 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
|
1086 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1087 doc: /* Return the multibyte equivalent of STRING. |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1088 If STRING is unibyte and contains non-ASCII characters, the function |
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1089 `unibyte-char-to-multibyte' is used to convert each unibyte character |
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1090 to a multibyte character. In this case, the returned string is a |
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1091 newly created string with no text properties. If STRING is multibyte |
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1092 or entirely ASCII, it is returned unchanged. In particular, when |
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1093 STRING is unibyte and entirely ASCII, the returned string is unibyte. |
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1094 \(When the characters are all ASCII, Emacs primitives will treat the |
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1095 string the same way whether it is unibyte or multibyte.) */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1096 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1097 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1098 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1099 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1100 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1101 return string_make_multibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1102 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1103 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1104 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
|
1105 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1106 doc: /* Return the unibyte equivalent of STRING. |
45650
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1107 Multibyte character codes are converted to unibyte according to |
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1108 `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
|
1109 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
|
1110 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
|
1111 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1112 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1113 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1114 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1115 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1116 return string_make_unibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1117 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1118 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1119 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
|
1120 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1121 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
|
1122 If STRING is unibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1123 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
|
1124 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
|
1125 `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
|
1126 corresponding single byte. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1127 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1128 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
|
1129 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1130 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1131 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1132 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
|
1133 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1134 int bytes = SBYTES (string); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1135 unsigned char *str = (unsigned char *) xmalloc (bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1136 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1137 bcopy (SDATA (string), str, bytes); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1138 bytes = str_as_unibyte (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1139 string = make_unibyte_string (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1140 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
|
1141 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1142 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1143 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1144 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1145 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
|
1146 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1147 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
|
1148 If STRING is multibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1149 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
|
1150 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
|
1151 part of a multibyte form), it is converted to the corresponding |
61433
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1152 multibyte character of charset `eight-bit-control' or `eight-bit-graphic'. |
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1153 Beware, this often doesn't really do what you think it does. |
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1154 It is similar to (decode-coding-string STRING 'emacs-mule-unix). |
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1155 If you're not sure, whether to use `string-as-multibyte' or |
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1156 `string-to-multibyte', use `string-to-multibyte'. Beware: |
64484
380dfb5322dc
(Fstring_as_multibyte): Escape backslashes in the
Kenichi Handa <handa@m17n.org>
parents:
64084
diff
changeset
|
1157 (aref (string-as-multibyte "\\201") 0) -> 129 (aka ?\\201) |
380dfb5322dc
(Fstring_as_multibyte): Escape backslashes in the
Kenichi Handa <handa@m17n.org>
parents:
64084
diff
changeset
|
1158 (aref (string-as-multibyte "\\300") 0) -> 192 (aka ?\\300) |
380dfb5322dc
(Fstring_as_multibyte): Escape backslashes in the
Kenichi Handa <handa@m17n.org>
parents:
64084
diff
changeset
|
1159 (aref (string-as-multibyte "\\300\\201") 0) -> 192 (aka ?\\300) |
380dfb5322dc
(Fstring_as_multibyte): Escape backslashes in the
Kenichi Handa <handa@m17n.org>
parents:
64084
diff
changeset
|
1160 (aref (string-as-multibyte "\\300\\201") 1) -> 129 (aka ?\\201) |
61433
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1161 but |
64484
380dfb5322dc
(Fstring_as_multibyte): Escape backslashes in the
Kenichi Handa <handa@m17n.org>
parents:
64084
diff
changeset
|
1162 (aref (string-as-multibyte "\\201\\300") 0) -> 2240 |
380dfb5322dc
(Fstring_as_multibyte): Escape backslashes in the
Kenichi Handa <handa@m17n.org>
parents:
64084
diff
changeset
|
1163 (aref (string-as-multibyte "\\201\\300") 1) -> <error> */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1164 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1165 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
|
1166 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1167 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1168 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1169 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
|
1170 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1171 Lisp_Object new_string; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1172 int nchars, nbytes; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1173 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1174 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
|
1175 SBYTES (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1176 &nchars, &nbytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1177 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
|
1178 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
|
1179 SBYTES (string)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1180 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
|
1181 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
|
1182 SBYTES (string), NULL); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1183 string = new_string; |
46379
18cf1d2514d9
* fns.c (Fstring_as_multibyte): Use STRING_SET_INTERVALS.
Ken Raeburn <raeburn@raeburn.org>
parents:
46374
diff
changeset
|
1184 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
|
1185 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1186 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1187 } |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1188 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1189 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
|
1190 1, 1, 0, |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1191 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
|
1192 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
|
1193 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
|
1194 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
|
1195 characters of the same character code. Characters 0240 through 0377 |
53042
ad6fbb925d66
(Fstring_to_multibyte): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
52766
diff
changeset
|
1196 are converted to eight-bit-graphic characters of the same character |
61433
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1197 codes. |
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1198 This is similar to (decode-coding-string STRING 'binary) */) |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1199 (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1200 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1201 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1202 CHECK_STRING (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1203 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1204 return string_to_multibyte (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1205 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1206 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1207 |
211 | 1208 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
|
1209 doc: /* Return a copy of ALIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1210 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
|
1211 but does not share the alist structure with ALIST. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1212 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
|
1213 are shared, however. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1214 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
|
1215 (alist) |
211 | 1216 Lisp_Object alist; |
1217 { | |
1218 register Lisp_Object tem; | |
1219 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1220 CHECK_LIST (alist); |
485 | 1221 if (NILP (alist)) |
211 | 1222 return alist; |
1223 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
|
1224 for (tem = alist; CONSP (tem); tem = XCDR (tem)) |
211 | 1225 { |
1226 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
|
1227 car = XCAR (tem); |
211 | 1228 |
1229 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
|
1230 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); |
211 | 1231 } |
1232 return alist; | |
1233 } | |
1234 | |
1235 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, | |
41006 | 1236 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
|
1237 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
|
1238 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
|
1239 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1240 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
|
1241 (string, from, to) |
211 | 1242 Lisp_Object string; |
1243 register Lisp_Object from, to; | |
1244 { | |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1245 Lisp_Object res; |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1246 int size; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1247 int size_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1248 int from_char, to_char; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1249 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
|
1250 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1251 if (! (STRINGP (string) || VECTORP (string))) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1252 wrong_type_argument (Qarrayp, string); |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1253 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1254 CHECK_NUMBER (from); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1255 |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1256 if (STRINGP (string)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1257 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1258 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
|
1259 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1260 } |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1261 else |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1262 size = XVECTOR (string)->size; |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1263 |
485 | 1264 if (NILP (to)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1265 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1266 to_char = size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1267 to_byte = size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1268 } |
211 | 1269 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1270 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1271 CHECK_NUMBER (to); |
20607
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 to_char = XINT (to); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1274 if (to_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1275 to_char += size; |
211 | 1276 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1277 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1278 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
|
1279 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1280 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1281 from_char = XINT (from); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1282 if (from_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1283 from_char += size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1284 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1285 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
|
1286 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1287 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
|
1288 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
|
1289 make_number (to_char)); |
211 | 1290 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1291 if (STRINGP (string)) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1292 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1293 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
|
1294 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
|
1295 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1296 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
|
1297 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
|
1298 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1299 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1300 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
|
1301 XVECTOR (string)->contents + from_char); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1302 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1303 return res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1304 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1305 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1306 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1307 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
|
1308 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
|
1309 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
|
1310 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
|
1311 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
|
1312 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
|
1313 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1314 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
|
1315 (string, from, to) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1316 Lisp_Object string; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1317 register Lisp_Object from, to; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1318 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1319 int size, size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1320 int from_char, to_char; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1321 int from_byte, to_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1322 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1323 CHECK_STRING (string); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1324 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1325 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
|
1326 size_byte = SBYTES (string); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1327 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1328 if (NILP (from)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1329 from_char = from_byte = 0; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1330 else |
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 CHECK_NUMBER (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1333 from_char = XINT (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1334 if (from_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1335 from_char += size; |
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 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
|
1338 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1339 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1340 if (NILP (to)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1341 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1342 to_char = size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1343 to_byte = size_byte; |
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 else |
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 CHECK_NUMBER (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1348 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1349 to_char = XINT (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1350 if (to_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1351 to_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1352 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1353 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
|
1354 } |
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 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
|
1357 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
|
1358 make_number (to_char)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1359 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1360 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
|
1361 to_char - from_char, to_byte - from_byte, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1362 STRING_MULTIBYTE (string)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1363 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1364 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1365 /* 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
|
1366 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
|
1367 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1368 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1369 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
|
1370 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1371 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
|
1372 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1373 Lisp_Object res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1374 int size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1375 int size_byte; |
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 if (! (STRINGP (string) || VECTORP (string))) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1378 wrong_type_argument (Qarrayp, string); |
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 (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1381 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1382 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
|
1383 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1384 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1385 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1386 size = XVECTOR (string)->size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1387 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1388 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
|
1389 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
|
1390 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1391 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1392 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1393 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
|
1394 to - from, to_byte - from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1395 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1396 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
|
1397 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
|
1398 } |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1399 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1400 res = Fvector (to - from, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1401 XVECTOR (string)->contents + from); |
20004 | 1402 |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1403 return res; |
211 | 1404 } |
1405 | |
1406 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
|
1407 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
|
1408 (n, list) |
211 | 1409 Lisp_Object n; |
1410 register Lisp_Object list; | |
1411 { | |
1412 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
|
1413 CHECK_NUMBER (n); |
211 | 1414 num = XINT (n); |
485 | 1415 for (i = 0; i < num && !NILP (list); i++) |
211 | 1416 { |
1417 QUIT; | |
26596 | 1418 if (! CONSP (list)) |
1419 wrong_type_argument (Qlistp, list); | |
1420 list = XCDR (list); | |
211 | 1421 } |
1422 return list; | |
1423 } | |
1424 | |
1425 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
|
1426 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
|
1427 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
|
1428 (n, list) |
211 | 1429 Lisp_Object n, list; |
1430 { | |
1431 return Fcar (Fnthcdr (n, list)); | |
1432 } | |
1433 | |
1434 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
|
1435 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
|
1436 (sequence, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1437 register Lisp_Object sequence, n; |
211 | 1438 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1439 CHECK_NUMBER (n); |
211 | 1440 while (1) |
1441 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1442 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
|
1443 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
|
1444 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
|
1445 || 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
|
1446 return Faref (sequence, n); |
211 | 1447 else |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1448 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 1449 } |
1450 } | |
1451 | |
1452 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
|
1453 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
|
1454 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
|
1455 (elt, list) |
211 | 1456 register Lisp_Object elt; |
1457 Lisp_Object list; | |
1458 { | |
1459 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
|
1460 for (tail = list; !NILP (tail); tail = XCDR (tail)) |
211 | 1461 { |
1462 register Lisp_Object tem; | |
26596 | 1463 if (! CONSP (tail)) |
1464 wrong_type_argument (Qlistp, list); | |
1465 tem = XCAR (tail); | |
485 | 1466 if (! NILP (Fequal (elt, tem))) |
211 | 1467 return tail; |
1468 QUIT; | |
1469 } | |
1470 return Qnil; | |
1471 } | |
1472 | |
1473 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
|
1474 doc: /* Return non-nil if ELT is an element of LIST. |
63173
66bf26afd9c6
(Fmemq, Fmaphash): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
62950
diff
changeset
|
1475 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
|
1476 whose car is ELT. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1477 (elt, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1478 Lisp_Object elt, list; |
211 | 1479 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1480 while (1) |
211 | 1481 { |
26230
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; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1484 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1485 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1486 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1487 break; |
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 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1490 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1491 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1492 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1493 list = XCDR (list); |
211 | 1494 QUIT; |
1495 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1496 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1497 if (!CONSP (list) && !NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1498 list = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1499 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1500 return list; |
211 | 1501 } |
1502 | |
1503 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
|
1504 doc: /* Return non-nil if KEY is `eq' to the car of an element of LIST. |
53115
988e1d16a971
(Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53106
diff
changeset
|
1505 The value is actually the first 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
|
1506 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
|
1507 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1508 Lisp_Object key, list; |
211 | 1509 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1510 Lisp_Object result; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1511 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1512 while (1) |
211 | 1513 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1514 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1515 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1516 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1517 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1518 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1519 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1520 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1521 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1522 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1523 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1524 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1525 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1526 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1527 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1528 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1529 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1530 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1531 list = XCDR (list); |
211 | 1532 QUIT; |
1533 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1534 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1535 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1536 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1537 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1538 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1539 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1540 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1541 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1542 return result; |
211 | 1543 } |
1544 | |
1545 /* Like Fassq but never report an error and do not allow quits. | |
1546 Use only on lists known never to be circular. */ | |
1547 | |
1548 Lisp_Object | |
1549 assq_no_quit (key, list) | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1550 Lisp_Object key, list; |
211 | 1551 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1552 while (CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1553 && (!CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1554 || !EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1555 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1556 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1557 return CONSP (list) ? XCAR (list) : Qnil; |
211 | 1558 } |
1559 | |
1560 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
|
1561 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST. |
53115
988e1d16a971
(Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53106
diff
changeset
|
1562 The value is actually the first element of LIST whose car equals KEY. */) |
54994
937db08d4048
(Fassoc, Feql): Fix indentation.
John Paul Wallington <jpw@pobox.com>
parents:
54987
diff
changeset
|
1563 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1564 Lisp_Object key, list; |
211 | 1565 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1566 Lisp_Object result, car; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1567 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1568 while (1) |
211 | 1569 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1570 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1571 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1572 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1573 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1574 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1575 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1576 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1577 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1578 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1579 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1580 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1581 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1582 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1583 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1584 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1585 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1586 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1587 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1588 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1589 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1590 list = XCDR (list); |
211 | 1591 QUIT; |
1592 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1593 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1594 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1595 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1596 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1597 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1598 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1599 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1600 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1601 return result; |
211 | 1602 } |
1603 | |
1604 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
|
1605 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. |
53115
988e1d16a971
(Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53106
diff
changeset
|
1606 The value is actually the first element of LIST whose cdr is KEY. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1607 (key, list) |
211 | 1608 register Lisp_Object key; |
1609 Lisp_Object list; | |
1610 { | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1611 Lisp_Object result; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1612 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1613 while (1) |
211 | 1614 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1615 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1616 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1617 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1618 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1619 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1620 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1621 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1622 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1623 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1624 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1625 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1626 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1627 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1628 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1629 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1630 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1631 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1632 list = XCDR (list); |
211 | 1633 QUIT; |
1634 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1635 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1636 if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1637 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1638 else if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1639 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1640 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1641 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1642 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1643 return result; |
211 | 1644 } |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1645 |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1646 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
|
1647 doc: /* Return non-nil if KEY is `equal' to the cdr of an element of LIST. |
53115
988e1d16a971
(Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53106
diff
changeset
|
1648 The value is actually the first element of LIST whose cdr equals KEY. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1649 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1650 Lisp_Object key, list; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1651 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1652 Lisp_Object result, cdr; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1653 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1654 while (1) |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1655 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1656 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1657 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1658 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1659 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1660 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1661 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1662 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1663 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1664 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1665 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1666 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1667 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1668 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1669 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1670 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1671 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1672 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1673 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1674 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1675 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1676 list = XCDR (list); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1677 QUIT; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1678 } |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1679 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1680 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1681 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1682 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1683 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1684 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1685 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1686 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1687 return result; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1688 } |
211 | 1689 |
1690 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
|
1691 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
|
1692 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
|
1693 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
|
1694 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
|
1695 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
|
1696 (elt, list) |
211 | 1697 register Lisp_Object elt; |
1698 Lisp_Object list; | |
1699 { | |
1700 register Lisp_Object tail, prev; | |
1701 register Lisp_Object tem; | |
1702 | |
1703 tail = list; | |
1704 prev = Qnil; | |
485 | 1705 while (!NILP (tail)) |
211 | 1706 { |
26596 | 1707 if (! CONSP (tail)) |
1708 wrong_type_argument (Qlistp, list); | |
1709 tem = XCAR (tail); | |
211 | 1710 if (EQ (elt, tem)) |
1711 { | |
485 | 1712 if (NILP (prev)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1713 list = XCDR (tail); |
211 | 1714 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1715 Fsetcdr (prev, XCDR (tail)); |
211 | 1716 } |
1717 else | |
1718 prev = tail; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1719 tail = XCDR (tail); |
211 | 1720 QUIT; |
1721 } | |
1722 return list; | |
1723 } | |
1724 | |
414 | 1725 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
|
1726 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
|
1727 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
|
1728 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
|
1729 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
|
1730 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
|
1731 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
|
1732 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
|
1733 (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
|
1734 Lisp_Object elt, seq; |
401 | 1735 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1736 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
|
1737 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
1738 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
|
1739 |
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 ++n; |
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 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
|
1745 { |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
1746 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
|
1747 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1748 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
|
1749 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
|
1750 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
|
1751 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1752 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
|
1753 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1754 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1755 else if (STRINGP (seq)) |
401 | 1756 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1757 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
|
1758 int c; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1759 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1760 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
|
1761 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
|
1762 ++i, ibyte += cbytes) |
401 | 1763 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1764 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
|
1765 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1766 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
|
1767 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
|
1768 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
|
1769 } |
401 | 1770 else |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1771 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1772 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
|
1773 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1774 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1775 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1776 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
|
1777 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1778 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1779 nbytes += cbytes; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1780 } |
401 | 1781 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1782 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1783 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
|
1784 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1785 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
|
1786 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1787 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
|
1788 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
|
1789 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
|
1790 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1791 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
|
1792 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
|
1793 ++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
|
1794 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1795 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
|
1796 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1797 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
|
1798 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
|
1799 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
|
1800 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1801 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1802 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1803 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
|
1804 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1805 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1806 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1807 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
|
1808 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1809 unsigned char *from = SDATA (seq) + ibyte; |
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1810 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
|
1811 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
|
1812 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1813 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1814 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
|
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 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
|
1817 *to++ = *from++; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1818 } |
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 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1821 seq = tem; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1822 } |
401 | 1823 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1824 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1825 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1826 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
|
1827 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1828 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
|
1829 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1830 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
|
1831 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
|
1832 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1833 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
|
1834 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1835 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
|
1836 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
|
1837 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1838 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
|
1839 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1840 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1841 prev = tail; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1842 QUIT; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1843 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1844 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1845 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1846 return seq; |
401 | 1847 } |
1848 | |
211 | 1849 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
|
1850 doc: /* Reverse LIST by modifying cdr pointers. |
53106 | 1851 Return the reversed list. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1852 (list) |
211 | 1853 Lisp_Object list; |
1854 { | |
1855 register Lisp_Object prev, tail, next; | |
1856 | |
485 | 1857 if (NILP (list)) return list; |
211 | 1858 prev = Qnil; |
1859 tail = list; | |
485 | 1860 while (!NILP (tail)) |
211 | 1861 { |
1862 QUIT; | |
26596 | 1863 if (! CONSP (tail)) |
1864 wrong_type_argument (Qlistp, list); | |
1865 next = XCDR (tail); | |
211 | 1866 Fsetcdr (tail, prev); |
1867 prev = tail; | |
1868 tail = next; | |
1869 } | |
1870 return prev; | |
1871 } | |
1872 | |
1873 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, | |
53106 | 1874 doc: /* Reverse LIST, copying. Return the reversed list. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1875 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
|
1876 (list) |
211 | 1877 Lisp_Object list; |
1878 { | |
18421 | 1879 Lisp_Object new; |
211 | 1880 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1881 for (new = Qnil; CONSP (list); list = XCDR (list)) |
49204 | 1882 { |
1883 QUIT; | |
1884 new = Fcons (XCAR (list), new); | |
1885 } | |
18421 | 1886 if (!NILP (list)) |
1887 wrong_type_argument (Qconsp, list); | |
1888 return new; | |
211 | 1889 } |
1890 | |
1891 Lisp_Object merge (); | |
1892 | |
1893 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
|
1894 doc: /* Sort LIST, stably, comparing elements using PREDICATE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1895 Returns the sorted list. LIST is modified by side effects. |
63602 | 1896 PREDICATE is called with two elements of LIST, and should return non-nil |
65325 | 1897 if the first element should sort before the second. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1898 (list, predicate) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1899 Lisp_Object list, predicate; |
211 | 1900 { |
1901 Lisp_Object front, back; | |
1902 register Lisp_Object len, tem; | |
1903 struct gcpro gcpro1, gcpro2; | |
1904 register int length; | |
1905 | |
1906 front = list; | |
1907 len = Flength (list); | |
1908 length = XINT (len); | |
1909 if (length < 2) | |
1910 return list; | |
1911 | |
1912 XSETINT (len, (length / 2) - 1); | |
1913 tem = Fnthcdr (len, list); | |
1914 back = Fcdr (tem); | |
1915 Fsetcdr (tem, Qnil); | |
1916 | |
1917 GCPRO2 (front, back); | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1918 front = Fsort (front, predicate); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1919 back = Fsort (back, predicate); |
211 | 1920 UNGCPRO; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1921 return merge (front, back, predicate); |
211 | 1922 } |
1923 | |
1924 Lisp_Object | |
1925 merge (org_l1, org_l2, pred) | |
1926 Lisp_Object org_l1, org_l2; | |
1927 Lisp_Object pred; | |
1928 { | |
1929 Lisp_Object value; | |
1930 register Lisp_Object tail; | |
1931 Lisp_Object tem; | |
1932 register Lisp_Object l1, l2; | |
1933 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1934 | |
1935 l1 = org_l1; | |
1936 l2 = org_l2; | |
1937 tail = Qnil; | |
1938 value = Qnil; | |
1939 | |
1940 /* It is sufficient to protect org_l1 and org_l2. | |
1941 When l1 and l2 are updated, we copy the new values | |
1942 back into the org_ vars. */ | |
1943 GCPRO4 (org_l1, org_l2, pred, value); | |
1944 | |
1945 while (1) | |
1946 { | |
485 | 1947 if (NILP (l1)) |
211 | 1948 { |
1949 UNGCPRO; | |
485 | 1950 if (NILP (tail)) |
211 | 1951 return l2; |
1952 Fsetcdr (tail, l2); | |
1953 return value; | |
1954 } | |
485 | 1955 if (NILP (l2)) |
211 | 1956 { |
1957 UNGCPRO; | |
485 | 1958 if (NILP (tail)) |
211 | 1959 return l1; |
1960 Fsetcdr (tail, l1); | |
1961 return value; | |
1962 } | |
1963 tem = call2 (pred, Fcar (l2), Fcar (l1)); | |
485 | 1964 if (NILP (tem)) |
211 | 1965 { |
1966 tem = l1; | |
1967 l1 = Fcdr (l1); | |
1968 org_l1 = l1; | |
1969 } | |
1970 else | |
1971 { | |
1972 tem = l2; | |
1973 l2 = Fcdr (l2); | |
1974 org_l2 = l2; | |
1975 } | |
485 | 1976 if (NILP (tail)) |
211 | 1977 value = tem; |
1978 else | |
1979 Fsetcdr (tail, tem); | |
1980 tail = tem; | |
1981 } | |
1982 } | |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1983 |
211 | 1984 |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1985 #if 0 /* Unsafe version. */ |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1986 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
|
1987 doc: /* Extract a value from a property list. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1988 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
|
1989 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1990 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
|
1991 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
|
1992 (plist, prop) |
14051
7f7e97f219ce
(Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents:
13862
diff
changeset
|
1993 Lisp_Object plist; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1994 Lisp_Object prop; |
211 | 1995 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1996 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1997 |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1998 for (tail = plist; |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1999 CONSP (tail) && CONSP (XCDR (tail)); |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2000 tail = XCDR (XCDR (tail))) |
211 | 2001 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2002 if (EQ (prop, XCAR (tail))) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2003 return XCAR (XCDR (tail)); |
37317
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
2004 |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
2005 /* 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
|
2006 (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
|
2007 if (!interrupt_input_blocked) |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
2008 QUIT; |
211 | 2009 } |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2010 |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2011 if (!NILP (tail)) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2012 wrong_type_argument (Qlistp, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2013 |
211 | 2014 return Qnil; |
2015 } | |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
2016 #endif |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
2017 |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
2018 /* This does not check for quits. That is safe since it must terminate. */ |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
2019 |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
2020 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, |
58239
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2021 doc: /* Extract a value from a property list. |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2022 PLIST is a property list, which is a list of the form |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2023 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
2024 corresponding to the given PROP, or nil if PROP is not one of the |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
2025 properties on the list. This function never signals an error. */) |
58239
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2026 (plist, prop) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2027 Lisp_Object plist; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2028 Lisp_Object prop; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2029 { |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2030 Lisp_Object tail, halftail; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2031 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2032 /* halftail is used to detect circular lists. */ |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2033 tail = halftail = plist; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2034 while (CONSP (tail) && CONSP (XCDR (tail))) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2035 { |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2036 if (EQ (prop, XCAR (tail))) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2037 return XCAR (XCDR (tail)); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2038 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2039 tail = XCDR (XCDR (tail)); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2040 halftail = XCDR (halftail); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2041 if (EQ (tail, halftail)) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2042 break; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2043 } |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2044 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2045 return Qnil; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2046 } |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
2047 |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2048 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
|
2049 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
|
2050 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
|
2051 (symbol, propname) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2052 Lisp_Object symbol, propname; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2053 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2054 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2055 return Fplist_get (XSYMBOL (symbol)->plist, propname); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2056 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2057 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2058 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
|
2059 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
|
2060 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
|
2061 \(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
|
2062 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
|
2063 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
|
2064 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
|
2065 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
|
2066 (plist, prop, val) |
20004 | 2067 Lisp_Object plist; |
2068 register Lisp_Object prop; | |
2069 Lisp_Object val; | |
211 | 2070 { |
2071 register Lisp_Object tail, prev; | |
2072 Lisp_Object newcell; | |
2073 prev = Qnil; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2074 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
|
2075 tail = XCDR (XCDR (tail))) |
211 | 2076 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2077 if (EQ (prop, XCAR (tail))) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2078 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2079 Fsetcar (XCDR (tail), val); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2080 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2081 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2082 |
211 | 2083 prev = tail; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2084 QUIT; |
211 | 2085 } |
2086 newcell = Fcons (prop, Fcons (val, Qnil)); | |
485 | 2087 if (NILP (prev)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2088 return newcell; |
211 | 2089 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2090 Fsetcdr (XCDR (prev), newcell); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2091 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2092 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2093 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2094 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
|
2095 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
|
2096 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
|
2097 (symbol, propname, value) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2098 Lisp_Object symbol, propname, value; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2099 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2100 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2101 XSYMBOL (symbol)->plist |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2102 = 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
|
2103 return value; |
211 | 2104 } |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2105 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2106 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
|
2107 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
|
2108 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
|
2109 \(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
|
2110 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
|
2111 one of the properties on the list. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2112 (plist, prop) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2113 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2114 Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2115 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2116 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2117 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2118 for (tail = plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2119 CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2120 tail = XCDR (XCDR (tail))) |
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 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2123 return XCAR (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2124 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2125 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2126 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2127 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2128 if (!NILP (tail)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2129 wrong_type_argument (Qlistp, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2130 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2131 return Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2132 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2133 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2134 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
|
2135 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
|
2136 PLIST is a property list, which is a list of the form |
44219 | 2137 \(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
|
2138 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
|
2139 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
|
2140 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
|
2141 The PLIST is modified by side effects. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2142 (plist, prop, val) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2143 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2144 register Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2145 Lisp_Object val; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2146 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2147 register Lisp_Object tail, prev; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2148 Lisp_Object newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2149 prev = Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2150 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2151 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2152 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2153 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2154 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2155 Fsetcar (XCDR (tail), val); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2156 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2157 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2158 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2159 prev = tail; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2160 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2161 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2162 newcell = Fcons (prop, Fcons (val, Qnil)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2163 if (NILP (prev)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2164 return newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2165 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2166 Fsetcdr (XCDR (prev), newcell); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2167 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2168 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2169 |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2170 DEFUN ("eql", Feql, Seql, 2, 2, 0, |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2171 doc: /* Return t if the two args are the same Lisp object. |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2172 Floating-point numbers of equal value are `eql', but they may not be `eq'. */) |
54994
937db08d4048
(Fassoc, Feql): Fix indentation.
John Paul Wallington <jpw@pobox.com>
parents:
54987
diff
changeset
|
2173 (obj1, obj2) |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2174 Lisp_Object obj1, obj2; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2175 { |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2176 if (FLOATP (obj1)) |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2177 return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2178 else |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2179 return EQ (obj1, obj2) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2180 } |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2181 |
211 | 2182 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
|
2183 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
|
2184 They must have the same data type. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2185 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
|
2186 Vectors and strings are compared element by element. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2187 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
|
2188 (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
|
2189 Symbols must match exactly. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2190 (o1, o2) |
211 | 2191 register Lisp_Object o1, o2; |
2192 { | |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2193 return internal_equal (o1, o2, 0, 0) ? Qt : Qnil; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2194 } |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2195 |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2196 DEFUN ("equal-including-properties", Fequal_including_properties, Sequal_including_properties, 2, 2, 0, |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2197 doc: /* Return t if two Lisp objects have similar structure and contents. |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2198 This is like `equal' except that it compares the text properties |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2199 of strings. (`equal' ignores text properties.) */) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2200 (o1, o2) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2201 register Lisp_Object o1, o2; |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2202 { |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2203 return internal_equal (o1, o2, 0, 1) ? Qt : Qnil; |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2204 } |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2205 |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2206 /* DEPTH is current depth of recursion. Signal an error if it |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2207 gets too deep. |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2208 PROPS, if non-nil, means compare string text properties too. */ |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2209 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2210 static int |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2211 internal_equal (o1, o2, depth, props) |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2212 register Lisp_Object o1, o2; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2213 int depth, props; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2214 { |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2215 if (depth > 200) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2216 error ("Stack overflow in equal"); |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2217 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2218 tail_recurse: |
211 | 2219 QUIT; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2220 if (EQ (o1, o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2221 return 1; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2222 if (XTYPE (o1) != XTYPE (o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2223 return 0; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2224 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2225 switch (XTYPE (o1)) |
211 | 2226 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2227 case Lisp_Float: |
53393
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2228 { |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2229 double d1, d2; |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2230 |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2231 d1 = extract_float (o1); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2232 d2 = extract_float (o2); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2233 /* If d is a NaN, then d != d. Two NaNs should be `equal' even |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2234 though they are not =. */ |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2235 return d1 == d2 || (d1 != d1 && d2 != d2); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2236 } |
10405
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_Cons: |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2239 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2240 return 0; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2241 o1 = XCDR (o1); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2242 o2 = XCDR (o2); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2243 goto tail_recurse; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2244 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2245 case Lisp_Misc: |
11240
2642924d2d21
(internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
2246 if (XMISCTYPE (o1) != XMISCTYPE (o2)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2247 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2248 if (OVERLAYP (o1)) |
211 | 2249 { |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2250 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2), |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2251 depth + 1, props) |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2252 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
2253 depth + 1, props)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2254 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2255 o1 = XOVERLAY (o1)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2256 o2 = XOVERLAY (o2)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2257 goto tail_recurse; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2258 } |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2259 if (MARKERP (o1)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2260 { |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2261 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
|
2262 && (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
|
2263 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); |
211 | 2264 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2265 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2266 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2267 case Lisp_Vectorlike: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2268 { |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2269 register int i; |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2270 EMACS_INT size = XVECTOR (o1)->size; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2271 /* 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
|
2272 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
|
2273 same size. */ |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2274 if (XVECTOR (o2)->size != size) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2275 return 0; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2276 /* Boolvectors are compared much like strings. */ |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2277 if (BOOL_VECTOR_P (o1)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2278 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2279 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2280 = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) |
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2281 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2282 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2283 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
|
2284 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2285 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
|
2286 size_in_chars)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2287 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2288 return 1; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2289 } |
20776
219fdecc30d3
(internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents:
20712
diff
changeset
|
2290 if (WINDOW_CONFIGURATIONP (o1)) |
21021
7be2384fabdc
(internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents:
20992
diff
changeset
|
2291 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
|
2292 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2293 /* 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
|
2294 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
|
2295 if (size & PSEUDOVECTOR_FLAG) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2296 { |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2297 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2298 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2299 size &= PSEUDOVECTOR_SIZE_MASK; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2300 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2301 for (i = 0; i < size; i++) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2302 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2303 Lisp_Object v1, v2; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2304 v1 = XVECTOR (o1)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2305 v2 = XVECTOR (o2)->contents [i]; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2306 if (!internal_equal (v1, v2, depth + 1, props)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2307 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2308 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2309 return 1; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2310 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2311 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2312 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2313 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
|
2314 if (SCHARS (o1) != SCHARS (o2)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2315 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
|
2316 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
|
2317 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
|
2318 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
|
2319 SBYTES (o1))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2320 return 0; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2321 if (props && !compare_string_intervals (o1, o2)) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2322 return 0; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2323 return 1; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2324 |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2325 case Lisp_Int: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2326 case Lisp_Symbol: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2327 case Lisp_Type_Limit: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2328 break; |
211 | 2329 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2330 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2331 return 0; |
211 | 2332 } |
2333 | |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
2334 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
|
2335 |
211 | 2336 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
|
2337 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
|
2338 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
|
2339 (array, item) |
211 | 2340 Lisp_Object array, item; |
2341 { | |
2342 register int size, index, charval; | |
2343 retry: | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2344 if (VECTORP (array)) |
211 | 2345 { |
2346 register Lisp_Object *p = XVECTOR (array)->contents; | |
2347 size = XVECTOR (array)->size; | |
2348 for (index = 0; index < size; index++) | |
2349 p[index] = item; | |
2350 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2351 else if (CHAR_TABLE_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2352 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2353 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
|
2354 size = CHAR_TABLE_ORDINARY_SLOTS; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2355 for (index = 0; index < size; index++) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2356 p[index] = item; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2357 XCHAR_TABLE (array)->defalt = Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2358 } |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2359 else if (STRINGP (array)) |
211 | 2360 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2361 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
|
2362 CHECK_NUMBER (item); |
211 | 2363 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
|
2364 size = SCHARS (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2365 if (STRING_MULTIBYTE (array)) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2366 { |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
2367 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
|
2368 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
|
2369 int size_byte = SBYTES (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2370 unsigned char *p1 = p, *endp = p + size_byte; |
23453
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2371 int i; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2372 |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2373 if (size != size_byte) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2374 while (p1 < endp) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2375 { |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2376 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2377 if (len != this_len) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2378 error ("Attempt to change byte length of a string"); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2379 p1 += this_len; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2380 } |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2381 for (i = 0; i < size_byte; i++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2382 *p++ = str[i % len]; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2383 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2384 else |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2385 for (index = 0; index < size; index++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2386 p[index] = charval; |
211 | 2387 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2388 else if (BOOL_VECTOR_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2389 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2390 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
|
2391 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2392 = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) |
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2393 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
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 charval = (! NILP (item) ? -1 : 0); |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2396 for (index = 0; index < size_in_chars - 1; index++) |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2397 p[index] = charval; |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2398 if (index < size_in_chars) |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2399 { |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2400 /* Mask out bits beyond the vector size. */ |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2401 if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR) |
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2402 charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1; |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2403 p[index] = charval; |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2404 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2405 } |
211 | 2406 else |
2407 { | |
2408 array = wrong_type_argument (Qarrayp, array); | |
2409 goto retry; | |
2410 } | |
2411 return array; | |
2412 } | |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2413 |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2414 DEFUN ("clear-string", Fclear_string, Sclear_string, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2415 1, 1, 0, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2416 doc: /* Clear the contents of STRING. |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2417 This makes STRING unibyte and may change its length. */) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2418 (string) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2419 Lisp_Object string; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2420 { |
56364
78e8df7d1ad8
(Fclear_string): Correct previous change.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56361
diff
changeset
|
2421 int len; |
56358
97e94a98c666
(Fclear_string): Signal an error if STRING is not a string.
John Paul Wallington <jpw@pobox.com>
parents:
56241
diff
changeset
|
2422 CHECK_STRING (string); |
56364
78e8df7d1ad8
(Fclear_string): Correct previous change.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56361
diff
changeset
|
2423 len = SBYTES (string); |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2424 bzero (SDATA (string), len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2425 STRING_SET_CHARS (string, len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2426 STRING_SET_UNIBYTE (string); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2427 return Qnil; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2428 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2429 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2430 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
|
2431 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2432 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
|
2433 (char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2434 Lisp_Object char_table; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2435 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2436 CHECK_CHAR_TABLE (char_table); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2437 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2438 return XCHAR_TABLE (char_table)->purpose; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2439 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2440 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2441 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
|
2442 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2443 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
|
2444 The value is either nil or another char-table. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2445 If CHAR-TABLE holds nil for a given character, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2446 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
|
2447 \(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
|
2448 (char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2449 Lisp_Object char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2450 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2451 CHECK_CHAR_TABLE (char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2452 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2453 return XCHAR_TABLE (char_table)->parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2454 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2455 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2456 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
|
2457 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2458 doc: /* Set the parent char-table of CHAR-TABLE to PARENT. |
53138
7cf5bcb7a8ad
(Fset_char_table_parent): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53115
diff
changeset
|
2459 Return PARENT. PARENT must be either nil or another char-table. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2460 (char_table, parent) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2461 Lisp_Object char_table, parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2462 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2463 Lisp_Object temp; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2464 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2465 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
|
2466 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2467 if (!NILP (parent)) |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2468 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2469 CHECK_CHAR_TABLE (parent); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2470 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2471 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
|
2472 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
|
2473 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
|
2474 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2475 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2476 XCHAR_TABLE (char_table)->parent = parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2477 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2478 return parent; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2479 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2480 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2481 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
|
2482 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2483 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
|
2484 (char_table, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2485 Lisp_Object char_table, n; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2486 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2487 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
|
2488 CHECK_NUMBER (n); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2489 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
|
2490 || 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
|
2491 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
|
2492 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2493 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
|
2494 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2495 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2496 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
|
2497 Sset_char_table_extra_slot, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2498 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2499 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
|
2500 (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
|
2501 Lisp_Object char_table, n, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2502 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2503 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
|
2504 CHECK_NUMBER (n); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2505 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
|
2506 || 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
|
2507 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
|
2508 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2509 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
|
2510 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2511 |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2512 static Lisp_Object |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2513 char_table_range (table, from, to, defalt) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2514 Lisp_Object table; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2515 int from, to; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2516 Lisp_Object defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2517 { |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2518 Lisp_Object val; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2519 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2520 if (! NILP (XCHAR_TABLE (table)->defalt)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2521 defalt = XCHAR_TABLE (table)->defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2522 val = XCHAR_TABLE (table)->contents[from]; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2523 if (SUB_CHAR_TABLE_P (val)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2524 val = char_table_range (val, 32, 127, defalt); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2525 else if (NILP (val)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2526 val = defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2527 for (from++; from <= to; from++) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2528 { |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2529 Lisp_Object this_val; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2530 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2531 this_val = XCHAR_TABLE (table)->contents[from]; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2532 if (SUB_CHAR_TABLE_P (this_val)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2533 this_val = char_table_range (this_val, 32, 127, defalt); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2534 else if (NILP (this_val)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2535 this_val = defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2536 if (! EQ (val, this_val)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2537 error ("Characters in the range have inconsistent values"); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2538 } |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2539 return val; |
62139
7f7d4a001320
(Fchar_table_range): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62137
diff
changeset
|
2540 } |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2541 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2542 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2543 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
|
2544 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2545 doc: /* Return the value in CHAR-TABLE for a range of characters RANGE. |
62139
7f7d4a001320
(Fchar_table_range): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62137
diff
changeset
|
2546 RANGE should be nil (for the default value), |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2547 a vector which identifies a character set or a row of a character set, |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2548 a character set name, or a character code. |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2549 If the characters in the specified range have different values, |
63616
82cc187b753d
(Fchar_table_range): Fix spellings.
Juanma Barranquero <lekktu@gmail.com>
parents:
63602
diff
changeset
|
2550 an error is signaled. |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2551 |
62139
7f7d4a001320
(Fchar_table_range): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62137
diff
changeset
|
2552 Note that this function doesn't check the parent of CHAR-TABLE. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2553 (char_table, range) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2554 Lisp_Object char_table, range; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2555 { |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2556 int charset_id, c1 = 0, c2 = 0; |
66236
bd4a75b12109
(Fchar_table_range): Remove unused var i.
Kim F. Storm <storm@cua.dk>
parents:
65713
diff
changeset
|
2557 int size; |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2558 Lisp_Object ch, val, current_default; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2559 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2560 CHECK_CHAR_TABLE (char_table); |
20004 | 2561 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2562 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
|
2563 return XCHAR_TABLE (char_table)->defalt; |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2564 if (INTEGERP (range)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2565 { |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2566 int c = XINT (range); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2567 if (! CHAR_VALID_P (c, 0)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2568 error ("Invalid character code: %d", c); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2569 ch = range; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2570 SPLIT_CHAR (c, charset_id, c1, c2); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2571 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2572 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
|
2573 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2574 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
|
2575 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2576 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
|
2577 CHECK_VECTOR (charset_info); |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2578 charset_id = XINT (XVECTOR (charset_info)->contents[0]); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2579 ch = Fmake_char_internal (make_number (charset_id), |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2580 make_number (0), make_number (0)); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2581 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2582 else if (VECTORP (range)) |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2583 { |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2584 size = ASIZE (range); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2585 if (size == 0) |
62137
4ca8167b7304
(Fchar_table_range): Yet Another Int/Lisp_Object Mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61838
diff
changeset
|
2586 args_out_of_range (range, make_number (0)); |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2587 CHECK_NUMBER (AREF (range, 0)); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2588 charset_id = XINT (AREF (range, 0)); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2589 if (size > 1) |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2590 { |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2591 CHECK_NUMBER (AREF (range, 1)); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2592 c1 = XINT (AREF (range, 1)); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2593 if (size > 2) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2594 { |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2595 CHECK_NUMBER (AREF (range, 2)); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2596 c2 = XINT (AREF (range, 2)); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2597 } |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2598 } |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2599 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2600 /* This checks if charset_id, c0, and c1 are all valid or not. */ |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2601 ch = Fmake_char_internal (make_number (charset_id), |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2602 make_number (c1), make_number (c2)); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2603 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2604 else |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2605 error ("Invalid RANGE argument to `char-table-range'"); |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2606 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2607 if (c1 > 0 && (CHARSET_DIMENSION (charset_id) == 1 || c2 > 0)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2608 { |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2609 /* Fully specified character. */ |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2610 Lisp_Object parent = XCHAR_TABLE (char_table)->parent; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2611 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2612 XCHAR_TABLE (char_table)->parent = Qnil; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2613 val = Faref (char_table, ch); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2614 XCHAR_TABLE (char_table)->parent = parent; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2615 return val; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2616 } |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2617 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2618 current_default = XCHAR_TABLE (char_table)->defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2619 if (charset_id == CHARSET_ASCII |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2620 || charset_id == CHARSET_8_BIT_CONTROL |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2621 || charset_id == CHARSET_8_BIT_GRAPHIC) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2622 { |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2623 int from, to, defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2624 |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2625 if (charset_id == CHARSET_ASCII) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2626 from = 0, to = 127, defalt = CHAR_TABLE_DEFAULT_SLOT_ASCII; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2627 else if (charset_id == CHARSET_8_BIT_CONTROL) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2628 from = 128, to = 159, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2629 else |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2630 from = 160, to = 255, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2631 if (! NILP (XCHAR_TABLE (char_table)->contents[defalt])) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2632 current_default = XCHAR_TABLE (char_table)->contents[defalt]; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2633 return char_table_range (char_table, from, to, current_default); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2634 } |
62139
7f7d4a001320
(Fchar_table_range): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62137
diff
changeset
|
2635 |
61838
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2636 val = XCHAR_TABLE (char_table)->contents[128 + charset_id]; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2637 if (! SUB_CHAR_TABLE_P (val)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2638 return (NILP (val) ? current_default : val); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2639 if (! NILP (XCHAR_TABLE (val)->defalt)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2640 current_default = XCHAR_TABLE (val)->defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2641 if (c1 == 0) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2642 return char_table_range (val, 32, 127, current_default); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2643 val = XCHAR_TABLE (val)->contents[c1]; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2644 if (! SUB_CHAR_TABLE_P (val)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2645 return (NILP (val) ? current_default : val); |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2646 if (! NILP (XCHAR_TABLE (val)->defalt)) |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2647 current_default = XCHAR_TABLE (val)->defalt; |
8ff9d677eeff
(char_table_range): New function.
Kenichi Handa <handa@m17n.org>
parents:
61735
diff
changeset
|
2648 return char_table_range (val, 32, 127, current_default); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2649 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2650 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2651 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
|
2652 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2653 doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE. |
53259
ee40f6db9683
(Fset_char_table_range): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53255
diff
changeset
|
2654 RANGE should be t (for all characters), nil (for the default value), |
ee40f6db9683
(Fset_char_table_range): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53255
diff
changeset
|
2655 a character set, a vector which identifies a character set, a row of a |
ee40f6db9683
(Fset_char_table_range): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53255
diff
changeset
|
2656 character set, or a character code. Return VALUE. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2657 (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
|
2658 Lisp_Object char_table, range, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2659 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2660 int i; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2661 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2662 CHECK_CHAR_TABLE (char_table); |
20004 | 2663 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2664 if (EQ (range, Qt)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2665 for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
61687
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2666 { |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2667 /* Don't set these special slots used for default values of |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2668 ascii, eight-bit-control, and eight-bit-graphic. */ |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2669 if (i != CHAR_TABLE_DEFAULT_SLOT_ASCII |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2670 && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2671 && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC) |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2672 XCHAR_TABLE (char_table)->contents[i] = value; |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2673 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2674 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
|
2675 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
|
2676 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
|
2677 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2678 Lisp_Object charset_info; |
53799
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2679 int charset_id; |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2680 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2681 charset_info = Fget (range, Qcharset); |
53799
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2682 if (! VECTORP (charset_info) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2683 || ! NATNUMP (AREF (charset_info, 0)) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2684 || (charset_id = XINT (AREF (charset_info, 0)), |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2685 ! CHARSET_DEFINED_P (charset_id))) |
53821
7848629711b6
(Fset_char_table_range): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
53799
diff
changeset
|
2686 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (range))); |
53799
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2687 |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2688 if (charset_id == CHARSET_ASCII) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2689 for (i = 0; i < 128; i++) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2690 XCHAR_TABLE (char_table)->contents[i] = value; |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2691 else if (charset_id == CHARSET_8_BIT_CONTROL) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2692 for (i = 128; i < 160; i++) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2693 XCHAR_TABLE (char_table)->contents[i] = value; |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2694 else if (charset_id == CHARSET_8_BIT_GRAPHIC) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2695 for (i = 160; i < 256; i++) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2696 XCHAR_TABLE (char_table)->contents[i] = value; |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2697 else |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2698 XCHAR_TABLE (char_table)->contents[charset_id + 128] = value; |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2699 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2700 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
|
2701 Faset (char_table, range, value); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2702 else if (VECTORP (range)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2703 { |
61687
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2704 int size = XVECTOR (range)->size; |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2705 Lisp_Object *val = XVECTOR (range)->contents; |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2706 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2707 size <= 1 ? Qnil : val[1], |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2708 size <= 2 ? Qnil : val[2]); |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2709 Faset (char_table, ch, value); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2710 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2711 else |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2712 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
|
2713 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2714 return value; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2715 } |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2716 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2717 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
|
2718 Sset_char_table_default, 3, 3, 0, |
51397 | 2719 doc: /* Set the default value in CHAR-TABLE for generic character CH to VALUE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2720 The generic character specifies the group of characters. |
61687
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2721 If CH is a normal character, set the default value for a group of |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2722 characters to which CH belongs. |
51397 | 2723 See also the documentation of `make-char'. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2724 (char_table, ch, value) |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2725 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
|
2726 { |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
2727 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
|
2728 Lisp_Object temp; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2729 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2730 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
|
2731 CHECK_NUMBER (ch); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2732 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2733 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
|
2734 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
|
2735 |
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2736 /* 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
|
2737 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
|
2738 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
|
2739 if (! CHARSET_VALID_P (charset)) |
22706 | 2740 invalid_character (c); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2741 |
61687
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2742 if (SINGLE_BYTE_CHAR_P (c)) |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2743 { |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2744 /* We use special slots for the default values of single byte |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2745 characters. */ |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2746 int default_slot |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2747 = (c < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2748 : c < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2749 : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2750 |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2751 return (XCHAR_TABLE (char_table)->contents[default_slot] = value); |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2752 } |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2753 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2754 /* 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
|
2755 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
|
2756 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
|
2757 code1 = 0; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2758 temp = XCHAR_TABLE (char_table)->contents[charset + 128]; |
61687
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2759 if (! SUB_CHAR_TABLE_P (temp)) |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2760 { |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2761 temp = make_sub_char_table (temp); |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2762 XCHAR_TABLE (char_table)->contents[charset + 128] = temp; |
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2763 } |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2764 if (!code1) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2765 { |
61687
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2766 XCHAR_TABLE (temp)->defalt = value; |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2767 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2768 } |
61687
fe8e91f043af
(Fset_char_table_range): Don't set slots used as default
Kenichi Handa <handa@m17n.org>
parents:
61645
diff
changeset
|
2769 char_table = temp; |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2770 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
|
2771 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
|
2772 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2773 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2774 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
|
2775 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2776 } |
21339
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2777 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2778 /* 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
|
2779 and return it as an integer. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2780 If the element is nil, return CH itself. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2781 (Actually we do that for any non-integer.) */ |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2782 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2783 int |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2784 char_table_translate (table, ch) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2785 Lisp_Object table; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2786 int ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2787 { |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2788 Lisp_Object value; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2789 value = Faref (table, make_number (ch)); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2790 if (! INTEGERP (value)) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2791 return ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2792 return XINT (value); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2793 } |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2794 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2795 static void |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2796 optimize_sub_char_table (table, chars) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2797 Lisp_Object *table; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2798 int chars; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2799 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2800 Lisp_Object elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2801 int from, to; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2802 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2803 if (chars == 94) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2804 from = 33, to = 127; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2805 else |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2806 from = 32, to = 128; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2807 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2808 if (!SUB_CHAR_TABLE_P (*table)) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2809 return; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2810 elt = XCHAR_TABLE (*table)->contents[from++]; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2811 for (; from < to; from++) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2812 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
|
2813 return; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2814 *table = elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2815 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2816 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2817 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
|
2818 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
|
2819 (table) |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2820 Lisp_Object table; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2821 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2822 Lisp_Object elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2823 int dim; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2824 int i, j; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2825 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2826 CHECK_CHAR_TABLE (table); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2827 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2828 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
|
2829 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2830 elt = XCHAR_TABLE (table)->contents[i]; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2831 if (!SUB_CHAR_TABLE_P (elt)) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2832 continue; |
33041
10bc9f620b67
(Foptimize_char_table): Fix arg for CHARSET_DIMENSION.
Kenichi Handa <handa@m17n.org>
parents:
32753
diff
changeset
|
2833 dim = CHARSET_DIMENSION (i - 128); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2834 if (dim == 2) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2835 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
|
2836 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
|
2837 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
|
2838 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2839 return Qnil; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2840 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2841 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2842 |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2843 /* 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
|
2844 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
|
2845 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
|
2846 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
|
2847 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
|
2848 |
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2849 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
|
2850 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2851 void |
51032
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2852 map_char_table (c_function, function, table, subtable, arg, depth, indices) |
20314
3fb425cf6a83
* fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents:
20148
diff
changeset
|
2853 void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); |
51032
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2854 Lisp_Object function, table, subtable, arg, *indices; |
16105
1712db4a1709
(map_char_table): Declare depth as int.
Richard M. Stallman <rms@gnu.org>
parents:
15966
diff
changeset
|
2855 int depth; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2856 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2857 int i, to; |
57482
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2858 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2859 |
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2860 GCPRO4 (arg, table, subtable, function); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2861 |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2862 if (depth == 0) |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2863 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2864 /* 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
|
2865 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
|
2866 { |
51032
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2867 Lisp_Object elt= XCHAR_TABLE (subtable)->contents[i]; |
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2868 if (NILP (elt)) |
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2869 elt = XCHAR_TABLE (subtable)->defalt; |
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2870 if (NILP (elt)) |
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2871 elt = Faref (subtable, make_number (i)); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2872 if (c_function) |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2873 (*c_function) (arg, make_number (i), elt); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2874 else |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2875 call2 (function, make_number (i), elt); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2876 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2877 #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
|
2878 we should report them. */ |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2879 if (NILP (current_buffer->enable_multibyte_characters)) |
57482
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2880 { |
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2881 UNGCPRO; |
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2882 return; |
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2883 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2884 #endif |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2885 to = CHAR_TABLE_ORDINARY_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2886 } |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2887 else |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2888 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2889 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
|
2890 |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2891 i = 32; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2892 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
|
2893 if (CHARSET_CHARS (charset) == 94) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2894 i++, to--; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2895 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2896 |
18000
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2897 for (; i < to; i++) |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2898 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2899 Lisp_Object elt; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2900 int charset; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2901 |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2902 elt = XCHAR_TABLE (subtable)->contents[i]; |
18108
af791b0f0657
(map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents:
18035
diff
changeset
|
2903 XSETFASTINT (indices[depth], i); |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2904 charset = XFASTINT (indices[0]) - 128; |
29232
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2905 if (depth == 0 |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2906 && (!CHARSET_DEFINED_P (charset) |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2907 || charset == CHARSET_8_BIT_CONTROL |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2908 || 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
|
2909 continue; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2910 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2911 if (SUB_CHAR_TABLE_P (elt)) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2912 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2913 if (depth >= 3) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2914 error ("Too deep char table"); |
51032
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2915 map_char_table (c_function, function, table, elt, arg, depth + 1, indices); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2916 } |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2917 else |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2918 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2919 int c1, c2, c; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2920 |
51038
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2921 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2922 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2923 c = MAKE_CHAR (charset, c1, c2); |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2924 |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2925 if (NILP (elt)) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2926 elt = XCHAR_TABLE (subtable)->defalt; |
51032
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2927 if (NILP (elt)) |
51038
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2928 elt = Faref (table, make_number (c)); |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2929 |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2930 if (c_function) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2931 (*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
|
2932 else |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2933 call2 (function, make_number (c), elt); |
20004 | 2934 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2935 } |
57482
72eb85758337
(map_char_table): Add missing gcpros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
56364
diff
changeset
|
2936 UNGCPRO; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2937 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2938 |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2939 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
|
2940 static void |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2941 void_call2 (a, b, c) |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2942 Lisp_Object a, b, c; |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2943 { |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2944 call2 (a, b, c); |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2945 } |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2946 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2947 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
|
2948 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2949 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
|
2950 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
|
2951 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
|
2952 (function, char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2953 Lisp_Object function, char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2954 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2955 /* 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
|
2956 Lisp_Object indices[3]; |
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2957 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2958 CHECK_CHAR_TABLE (char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2959 |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2960 /* 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
|
2961 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
|
2962 than returning nothing. |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2963 Casting leads to crashes on some architectures. -stef */ |
51032
663da44e6176
(map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents:
50461
diff
changeset
|
2964 map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2965 return Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2966 } |
30488
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2967 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2968 /* 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
|
2969 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
|
2970 TABLE. */ |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2971 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2972 Lisp_Object |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2973 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
|
2974 Lisp_Object table; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2975 int c, *idx; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2976 { |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2977 int charset, c1, c2; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2978 Lisp_Object elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2979 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2980 if (SINGLE_BYTE_CHAR_P (c)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2981 { |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2982 *idx = c; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2983 return XCHAR_TABLE (table)->contents[c]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2984 } |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2985 SPLIT_CHAR (c, charset, c1, c2); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2986 elt = XCHAR_TABLE (table)->contents[charset + 128]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2987 *idx = MAKE_CHAR (charset, 0, 0); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2988 if (!SUB_CHAR_TABLE_P (elt)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2989 return elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2990 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
|
2991 return XCHAR_TABLE (elt)->defalt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2992 elt = XCHAR_TABLE (elt)->contents[c1]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2993 *idx = MAKE_CHAR (charset, c1, 0); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2994 if (!SUB_CHAR_TABLE_P (elt)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2995 return elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2996 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
|
2997 return XCHAR_TABLE (elt)->defalt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2998 *idx = c; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2999 return XCHAR_TABLE (elt)->contents[c2]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
3000 } |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
3001 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
3002 |
211 | 3003 /* ARGSUSED */ |
3004 Lisp_Object | |
3005 nconc2 (s1, s2) | |
3006 Lisp_Object s1, s2; | |
3007 { | |
3008 #ifdef NO_ARG_ARRAY | |
3009 Lisp_Object args[2]; | |
3010 args[0] = s1; | |
3011 args[1] = s2; | |
3012 return Fnconc (2, args); | |
3013 #else | |
3014 return Fnconc (2, &s1); | |
3015 #endif /* NO_ARG_ARRAY */ | |
3016 } | |
3017 | |
3018 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
|
3019 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
|
3020 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
|
3021 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
|
3022 (nargs, args) |
211 | 3023 int nargs; |
3024 Lisp_Object *args; | |
3025 { | |
3026 register int argnum; | |
3027 register Lisp_Object tail, tem, val; | |
3028 | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
3029 val = tail = Qnil; |
211 | 3030 |
3031 for (argnum = 0; argnum < nargs; argnum++) | |
3032 { | |
3033 tem = args[argnum]; | |
485 | 3034 if (NILP (tem)) continue; |
211 | 3035 |
485 | 3036 if (NILP (val)) |
211 | 3037 val = tem; |
3038 | |
3039 if (argnum + 1 == nargs) break; | |
3040 | |
3041 if (!CONSP (tem)) | |
3042 tem = wrong_type_argument (Qlistp, tem); | |
3043 | |
3044 while (CONSP (tem)) | |
3045 { | |
3046 tail = tem; | |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
3047 tem = XCDR (tail); |
211 | 3048 QUIT; |
3049 } | |
3050 | |
3051 tem = args[argnum + 1]; | |
3052 Fsetcdr (tail, tem); | |
485 | 3053 if (NILP (tem)) |
211 | 3054 args[argnum + 1] = tail; |
3055 } | |
3056 | |
3057 return val; | |
3058 } | |
3059 | |
3060 /* 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
|
3061 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
|
3062 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
|
3063 LENI is the length of VALS, which should also be the length of SEQ. */ |
211 | 3064 |
3065 static void | |
3066 mapcar1 (leni, vals, fn, seq) | |
3067 int leni; | |
3068 Lisp_Object *vals; | |
3069 Lisp_Object fn, seq; | |
3070 { | |
3071 register Lisp_Object tail; | |
3072 Lisp_Object dummy; | |
3073 register int i; | |
3074 struct gcpro gcpro1, gcpro2, gcpro3; | |
3075 | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3076 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3077 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3078 /* 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
|
3079 for (i = 0; i < leni; i++) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3080 vals[i] = Qnil; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3081 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3082 GCPRO3 (dummy, fn, seq); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3083 gcpro1.var = vals; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3084 gcpro1.nvars = leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3085 } |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3086 else |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3087 GCPRO2 (fn, seq); |
211 | 3088 /* We need not explicitly protect `tail' because it is used only on lists, and |
3089 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ | |
3090 | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
3091 if (VECTORP (seq)) |
211 | 3092 { |
3093 for (i = 0; i < leni; i++) | |
3094 { | |
3095 dummy = XVECTOR (seq)->contents[i]; | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3096 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3097 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3098 vals[i] = dummy; |
211 | 3099 } |
3100 } | |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3101 else if (BOOL_VECTOR_P (seq)) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3102 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3103 for (i = 0; i < leni; i++) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3104 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3105 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
3106 byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR]; |
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
3107 if (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3108 dummy = Qt; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3109 else |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3110 dummy = Qnil; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3111 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3112 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3113 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3114 vals[i] = dummy; |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3115 } |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
3116 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3117 else if (STRINGP (seq)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3118 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3119 int i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3120 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3121 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
|
3122 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3123 int c; |
20712
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3124 int i_before = i; |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3125 |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
3126 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
|
3127 XSETFASTINT (dummy, c); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3128 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3129 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3130 vals[i_before] = dummy; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3131 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
3132 } |
211 | 3133 else /* Must be a list, since Flength did not get an error */ |
3134 { | |
3135 tail = seq; | |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
3136 for (i = 0; i < leni && CONSP (tail); i++) |
211 | 3137 { |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
3138 dummy = call1 (fn, XCAR (tail)); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3139 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3140 vals[i] = dummy; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
3141 tail = XCDR (tail); |
211 | 3142 } |
3143 } | |
3144 | |
3145 UNGCPRO; | |
3146 } | |
3147 | |
3148 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
|
3149 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
|
3150 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
|
3151 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
|
3152 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
|
3153 (function, sequence, separator) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3154 Lisp_Object function, sequence, separator; |
211 | 3155 { |
3156 Lisp_Object len; | |
3157 register int leni; | |
3158 int nargs; | |
3159 register Lisp_Object *args; | |
3160 register int i; | |
3161 struct gcpro gcpro1; | |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3162 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3163 USE_SAFE_ALLOCA; |
211 | 3164 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3165 len = Flength (sequence); |
211 | 3166 leni = XINT (len); |
3167 nargs = leni + leni - 1; | |
3168 if (nargs < 0) return build_string (""); | |
3169 | |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
3170 SAFE_ALLOCA_LISP (args, nargs); |
211 | 3171 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3172 GCPRO1 (separator); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3173 mapcar1 (leni, args, function, sequence); |
211 | 3174 UNGCPRO; |
3175 | |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
3176 for (i = leni - 1; i > 0; i--) |
211 | 3177 args[i + i] = args[i]; |
20004 | 3178 |
211 | 3179 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
|
3180 args[i] = separator; |
211 | 3181 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3182 ret = Fconcat (nargs, args); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3183 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3184 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3185 return ret; |
211 | 3186 } |
3187 | |
3188 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
|
3189 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
|
3190 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
|
3191 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
|
3192 (function, sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3193 Lisp_Object function, sequence; |
211 | 3194 { |
3195 register Lisp_Object len; | |
3196 register int leni; | |
3197 register Lisp_Object *args; | |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3198 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3199 USE_SAFE_ALLOCA; |
211 | 3200 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3201 len = Flength (sequence); |
211 | 3202 leni = XFASTINT (len); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3203 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
3204 SAFE_ALLOCA_LISP (args, leni); |
211 | 3205 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3206 mapcar1 (leni, args, function, sequence); |
211 | 3207 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3208 ret = Flist (leni, args); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3209 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3210 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3211 return ret; |
211 | 3212 } |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3213 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3214 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
|
3215 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
|
3216 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
|
3217 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
|
3218 (function, sequence) |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3219 Lisp_Object function, sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3220 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3221 register int leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3222 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3223 leni = XFASTINT (Flength (sequence)); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3224 mapcar1 (leni, 0, function, sequence); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3225 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3226 return sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3227 } |
211 | 3228 |
3229 /* Anything that calls this function must protect from GC! */ | |
3230 | |
3231 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
|
3232 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
|
3233 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
|
3234 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
|
3235 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
|
3236 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
|
3237 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
|
3238 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
|
3239 `recenter', and `quit'.\) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3240 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3241 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
|
3242 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
|
3243 (prompt) |
211 | 3244 Lisp_Object prompt; |
3245 { | |
25071 | 3246 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
|
3247 register int answer; |
211 | 3248 Lisp_Object xprompt; |
3249 Lisp_Object args[2]; | |
3250 struct gcpro gcpro1, gcpro2; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
3251 int count = SPECPDL_INDEX (); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3252 |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3253 specbind (Qcursor_in_echo_area, Qt); |
211 | 3254 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3255 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
|
3256 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3257 CHECK_STRING (prompt); |
211 | 3258 xprompt = prompt; |
3259 GCPRO2 (prompt, xprompt); | |
3260 | |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
3261 #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
|
3262 if (display_hourglass_p) |
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents:
35513
diff
changeset
|
3263 cancel_hourglass (); |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
3264 #endif |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3265 |
211 | 3266 while (1) |
3267 { | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3268 |
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
|
3269 #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
|
3270 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
|
3271 && 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
|
3272 && 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
|
3273 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3274 Lisp_Object pane, menu; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
3275 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
|
3276 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
|
3277 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
|
3278 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
|
3279 menu = Fcons (prompt, pane); |
62674
100b8f001349
(Fyes_or_no_p, Fy_or_n_p): Call Fx_popup_dialog with
Nick Roberts <nickrob@snap.net.nz>
parents:
62139
diff
changeset
|
3280 obj = Fx_popup_dialog (Qt, menu, Qnil); |
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
|
3281 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
|
3282 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
|
3283 } |
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
|
3284 #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
|
3285 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
|
3286 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
|
3287 |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3288 { |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3289 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
|
3290 |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3291 /* 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
|
3292 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
|
3293 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
|
3294 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
|
3295 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
|
3296 args[1] = xprompt; |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3297 Fmessage (2, args); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3298 } |
211 | 3299 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3300 if (minibuffer_auto_raise) |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3301 { |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3302 Lisp_Object mini_frame; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3303 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3304 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3305 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3306 Fraise_frame (mini_frame); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3307 } |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3308 |
23057
2dbf1ec20bf7
(Fy_or_n_p): Don't bind input-method-function.
Richard M. Stallman <rms@gnu.org>
parents:
23051
diff
changeset
|
3309 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
|
3310 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
|
3311 /* 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
|
3312 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
|
3313 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3314 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
|
3315 def = Flookup_key (map, key, Qt); |
211 | 3316 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3317 if (EQ (def, intern ("skip"))) |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3318 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3319 answer = 0; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3320 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3321 } |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3322 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
|
3323 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3324 answer = 1; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3325 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3326 } |
2311
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3327 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
|
3328 { |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3329 Frecenter (Qnil); |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3330 xprompt = prompt; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3331 continue; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3332 } |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3333 else if (EQ (def, intern ("quit"))) |
211 | 3334 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
|
3335 /* 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
|
3336 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
|
3337 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
|
3338 Vquit_flag = Qt; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3339 |
211 | 3340 QUIT; |
1194 | 3341 |
3342 /* If we don't clear this, then the next call to read_char will | |
3343 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
|
3344 Vquit_flag = Qnil; |
211 | 3345 |
3346 Fding (Qnil); | |
3347 Fdiscard_input (); | |
3348 if (EQ (xprompt, prompt)) | |
3349 { | |
3350 args[0] = build_string ("Please answer y or n. "); | |
3351 args[1] = prompt; | |
3352 xprompt = Fconcat (2, args); | |
3353 } | |
3354 } | |
3355 UNGCPRO; | |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
3356 |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3357 if (! noninteractive) |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3358 { |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3359 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
|
3360 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
|
3361 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
|
3362 } |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
3363 |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3364 unbind_to (count, Qnil); |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3365 return answer ? Qt : Qnil; |
211 | 3366 } |
3367 | |
3368 /* This is how C code calls `yes-or-no-p' and allows the user | |
3369 to redefined it. | |
3370 | |
3371 Anything that calls this function must protect from GC! */ | |
3372 | |
3373 Lisp_Object | |
3374 do_yes_or_no_p (prompt) | |
3375 Lisp_Object prompt; | |
3376 { | |
3377 return call1 (intern ("yes-or-no-p"), prompt); | |
3378 } | |
3379 | |
3380 /* Anything that calls this function must protect from GC! */ | |
3381 | |
3382 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
|
3383 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
|
3384 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
|
3385 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
|
3386 The user must confirm the answer with RET, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3387 and can edit it until it has been confirmed. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3388 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3389 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
|
3390 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
|
3391 (prompt) |
211 | 3392 Lisp_Object prompt; |
3393 { | |
3394 register Lisp_Object ans; | |
3395 Lisp_Object args[2]; | |
3396 struct gcpro gcpro1; | |
3397 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3398 CHECK_STRING (prompt); |
211 | 3399 |
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
|
3400 #ifdef HAVE_MENUS |
20004 | 3401 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
|
3402 && 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
|
3403 && 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
|
3404 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3405 Lisp_Object pane, menu, obj; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
3406 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
|
3407 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
|
3408 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
|
3409 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
|
3410 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
|
3411 menu = Fcons (prompt, pane); |
62674
100b8f001349
(Fyes_or_no_p, Fy_or_n_p): Call Fx_popup_dialog with
Nick Roberts <nickrob@snap.net.nz>
parents:
62139
diff
changeset
|
3412 obj = Fx_popup_dialog (Qt, menu, Qnil); |
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
|
3413 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
|
3414 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
|
3415 } |
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
|
3416 #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
|
3417 |
211 | 3418 args[0] = prompt; |
3419 args[1] = build_string ("(yes or no) "); | |
3420 prompt = Fconcat (2, args); | |
3421 | |
3422 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
|
3423 |
211 | 3424 while (1) |
3425 { | |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
3426 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
|
3427 Qyes_or_no_p_history, Qnil, |
58379
0f1b514dc439
(Fyes_or_no_p): Call Fread_from_minibuffer with extra argument.
Luc Teirlinck <teirllm@auburn.edu>
parents:
58265
diff
changeset
|
3428 Qnil, Qnil)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3429 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes")) |
211 | 3430 { |
3431 UNGCPRO; | |
3432 return Qt; | |
3433 } | |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3434 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no")) |
211 | 3435 { |
3436 UNGCPRO; | |
3437 return Qnil; | |
3438 } | |
3439 | |
3440 Fding (Qnil); | |
3441 Fdiscard_input (); | |
3442 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
|
3443 Fsleep_for (make_number (2), Qnil); |
211 | 3444 } |
3445 } | |
3446 | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3447 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
|
3448 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
|
3449 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3450 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
|
3451 to integer. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3452 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3453 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
|
3454 These floats are not multiplied by 100. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3455 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3456 If the 5-minute or 15-minute load averages are not available, return a |
51397 | 3457 shortened list, containing only those averages which are available. |
3458 | |
3459 An error is thrown if the load average can't be obtained. In some | |
3460 cases making it work would require Emacs being installed setuid or | |
3461 setgid so that it can read kernel information, and that usually isn't | |
3462 advisable. */) | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3463 (use_floats) |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3464 Lisp_Object use_floats; |
211 | 3465 { |
727 | 3466 double load_ave[3]; |
3467 int loads = getloadavg (load_ave, 3); | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3468 Lisp_Object ret = Qnil; |
211 | 3469 |
727 | 3470 if (loads < 0) |
3471 error ("load-average not implemented for this operating system"); | |
211 | 3472 |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3473 while (loads-- > 0) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3474 { |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3475 Lisp_Object load = (NILP (use_floats) ? |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3476 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
|
3477 : make_float (load_ave[loads])); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3478 ret = Fcons (load, ret); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3479 } |
211 | 3480 |
727 | 3481 return ret; |
211 | 3482 } |
3483 | |
39968
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
3484 Lisp_Object Vfeatures, Qsubfeatures; |
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
3485 extern Lisp_Object Vafter_load_alist; |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3486 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3487 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
|
3488 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
|
3489 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3490 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
|
3491 presence or absence of emacs or environment extensions. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3492 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
|
3493 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
|
3494 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
|
3495 (feature, subfeature) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3496 Lisp_Object feature, subfeature; |
211 | 3497 { |
3498 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
|
3499 CHECK_SYMBOL (feature); |
211 | 3500 tem = Fmemq (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3501 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
|
3502 tem = Fmember (subfeature, Fget (feature, Qsubfeatures)); |
485 | 3503 return (NILP (tem)) ? Qnil : Qt; |
211 | 3504 } |
3505 | |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3506 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
|
3507 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
|
3508 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
|
3509 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
|
3510 (feature, subfeatures) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3511 Lisp_Object feature, subfeatures; |
211 | 3512 { |
3513 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
|
3514 CHECK_SYMBOL (feature); |
44066
d0bef01f3cb3
(Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents:
41006
diff
changeset
|
3515 CHECK_LIST (subfeatures); |
485 | 3516 if (!NILP (Vautoload_queue)) |
211 | 3517 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); |
3518 tem = Fmemq (feature, Vfeatures); | |
485 | 3519 if (NILP (tem)) |
211 | 3520 Vfeatures = Fcons (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3521 if (!NILP (subfeatures)) |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3522 Fput (feature, Qsubfeatures, subfeatures); |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
3523 LOADHIST_ATTACH (Fcons (Qprovide, feature)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3524 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3525 /* Run any load-hooks for this file. */ |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3526 tem = Fassq (feature, Vafter_load_alist); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
3527 if (CONSP (tem)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
3528 Fprogn (XCDR (tem)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3529 |
211 | 3530 return feature; |
3531 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3532 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3533 /* `require' and its subroutines. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3534 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3535 /* 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
|
3536 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3537 Lisp_Object require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3538 |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
3539 Lisp_Object |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3540 require_unwind (old_value) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3541 Lisp_Object old_value; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3542 { |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
3543 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
|
3544 } |
211 | 3545 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3546 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
|
3547 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
|
3548 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
|
3549 is not loaded; so load the file FILENAME. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3550 If FILENAME is omitted, the printname of FEATURE is used as the file name, |
52766 | 3551 and `load' will try to load this name appended with the suffix `.elc' or |
3552 `.el', in that order. The name without appended suffix will not be used. | |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3553 If the optional third argument NOERROR is non-nil, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3554 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
|
3555 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
|
3556 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
|
3557 (feature, filename, noerror) |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
3558 Lisp_Object feature, filename, noerror; |
211 | 3559 { |
3560 register Lisp_Object tem; | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3561 struct gcpro gcpro1, gcpro2; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3562 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3563 CHECK_SYMBOL (feature); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3564 |
59490
dc3b1db0bed2
(Frequire): Record in load-history unconditionally.
Richard M. Stallman <rms@gnu.org>
parents:
59146
diff
changeset
|
3565 /* Record the presence of `require' in this file |
61417
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3566 even if the feature specified is already loaded. |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3567 But not more than once in any file, |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3568 and not when we aren't loading a file. */ |
61622
aef105b11011
(Vloads_in_progress): Remove extern.
Lute Kamstra <lute@gnu.org>
parents:
61433
diff
changeset
|
3569 if (load_in_progress) |
61417
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3570 { |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3571 tem = Fcons (Qrequire, feature); |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3572 if (NILP (Fmember (tem, Vcurrent_load_list))) |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3573 LOADHIST_ATTACH (tem); |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
3574 } |
211 | 3575 tem = Fmemq (feature, Vfeatures); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3576 |
485 | 3577 if (NILP (tem)) |
211 | 3578 { |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
3579 int count = SPECPDL_INDEX (); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3580 int nesting = 0; |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3581 |
45039 | 3582 /* This is to make sure that loadup.el gives a clear picture |
3583 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
|
3584 if (! NILP (Vpurify_flag)) |
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3585 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
|
3586 SDATA (SYMBOL_NAME (feature))); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3587 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3588 /* 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
|
3589 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
|
3590 signal an error. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3591 tem = require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3592 while (! NILP (tem)) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3593 { |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3594 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
|
3595 nesting++; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3596 tem = XCDR (tem); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3597 } |
48567
ecf43ac20827
fns.c (Frequire): Change nesting allowance from 2 to 3 to cause more
Steven Tamm <steventamm@mac.com>
parents:
48337
diff
changeset
|
3598 if (nesting > 3) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3599 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
|
3600 SDATA (SYMBOL_NAME (feature))); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3601 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3602 /* 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
|
3603 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
|
3604 require_nesting_list = Fcons (feature, require_nesting_list); |
211 | 3605 |
3606 /* Value saved here is to be restored into Vautoload_queue */ | |
3607 record_unwind_protect (un_autoload, Vautoload_queue); | |
3608 Vautoload_queue = Qt; | |
3609 | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3610 /* Load the file. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3611 GCPRO2 (feature, filename); |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
3612 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
|
3613 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
|
3614 UNGCPRO; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3615 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3616 /* If load failed entirely, return nil. */ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3617 if (NILP (tem)) |
24016
43344f47a865
(Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents:
23927
diff
changeset
|
3618 return unbind_to (count, Qnil); |
211 | 3619 |
3620 tem = Fmemq (feature, Vfeatures); | |
485 | 3621 if (NILP (tem)) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3622 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
|
3623 SDATA (SYMBOL_NAME (feature))); |
211 | 3624 |
3625 /* Once loading finishes, don't undo it. */ | |
3626 Vautoload_queue = Qt; | |
3627 feature = unbind_to (count, feature); | |
3628 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3629 |
211 | 3630 return feature; |
3631 } | |
3632 | |
20004 | 3633 /* Primitives for work of the "widget" library. |
3634 In an ideal world, this section would not have been necessary. | |
3635 However, lisp function calls being as slow as they are, it turns | |
3636 out that some functions in the widget library (wid-edit.el) are the | |
3637 bottleneck of Widget operation. Here is their translation to C, | |
3638 for the sole reason of efficiency. */ | |
3639 | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3640 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
|
3641 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
|
3642 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
|
3643 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3644 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
|
3645 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
|
3646 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
|
3647 (plist, prop) |
20004 | 3648 Lisp_Object plist, prop; |
3649 { | |
3650 while (CONSP (plist) && !EQ (XCAR (plist), prop)) | |
3651 { | |
3652 QUIT; | |
3653 plist = XCDR (plist); | |
3654 plist = CDR (plist); | |
3655 } | |
3656 return plist; | |
3657 } | |
3658 | |
3659 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
|
3660 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
|
3661 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
|
3662 (widget, property, value) |
20004 | 3663 Lisp_Object widget, property, value; |
3664 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3665 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
|
3666 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
|
3667 return value; |
20004 | 3668 } |
3669 | |
3670 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
|
3671 doc: /* In WIDGET, get the value of PROPERTY. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3672 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
|
3673 later with `widget-put'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3674 (widget, property) |
20004 | 3675 Lisp_Object widget, property; |
3676 { | |
3677 Lisp_Object tmp; | |
3678 | |
3679 while (1) | |
3680 { | |
3681 if (NILP (widget)) | |
3682 return Qnil; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3683 CHECK_CONS (widget); |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3684 tmp = Fplist_member (XCDR (widget), property); |
20004 | 3685 if (CONSP (tmp)) |
3686 { | |
3687 tmp = XCDR (tmp); | |
3688 return CAR (tmp); | |
3689 } | |
3690 tmp = XCAR (widget); | |
3691 if (NILP (tmp)) | |
3692 return Qnil; | |
3693 widget = Fget (tmp, Qwidget_type); | |
3694 } | |
3695 } | |
3696 | |
3697 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
|
3698 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
|
3699 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
|
3700 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
|
3701 (nargs, args) |
20004 | 3702 int nargs; |
3703 Lisp_Object *args; | |
3704 { | |
3705 /* This function can GC. */ | |
3706 Lisp_Object newargs[3]; | |
3707 struct gcpro gcpro1, gcpro2; | |
3708 Lisp_Object result; | |
3709 | |
3710 newargs[0] = Fwidget_get (args[0], args[1]); | |
3711 newargs[1] = args[0]; | |
3712 newargs[2] = Flist (nargs - 2, args + 2); | |
3713 GCPRO2 (newargs[0], newargs[2]); | |
3714 result = Fapply (3, newargs); | |
3715 UNGCPRO; | |
3716 return result; | |
3717 } | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3718 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3719 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3720 #include <langinfo.h> |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3721 #endif |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3722 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3723 DEFUN ("locale-info", Flocale_info, Slocale_info, 1, 1, 0, |
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3724 doc: /* Access locale data ITEM for the current C locale, if available. |
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3725 ITEM should be one of the following: |
51397 | 3726 |
49798 | 3727 `codeset', returning the character set as a string (locale item CODESET); |
51397 | 3728 |
49798 | 3729 `days', returning a 7-element vector of day names (locale items DAY_n); |
51397 | 3730 |
49798 | 3731 `months', returning a 12-element vector of month names (locale items MON_n); |
51397 | 3732 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3733 `paper', returning a list (WIDTH HEIGHT) for the default paper size, |
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3734 both measured in milimeters (locale items PAPER_WIDTH, PAPER_HEIGHT). |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3735 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3736 If the system can't provide such information through a call to |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3737 `nl_langinfo', or if ITEM isn't from the list above, return nil. |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3738 |
49798 | 3739 See also Info node `(libc)Locales'. |
3740 | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3741 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
|
3742 (item) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3743 Lisp_Object item; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3744 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3745 char *str = NULL; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3746 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3747 Lisp_Object val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3748 if (EQ (item, Qcodeset)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3749 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3750 str = nl_langinfo (CODESET); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3751 return build_string (str); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3752 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3753 #ifdef DAY_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3754 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
|
3755 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3756 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
|
3757 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
|
3758 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3759 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3760 for (i = 0; i < 7; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3761 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3762 str = nl_langinfo (days[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3763 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
|
3764 /* 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
|
3765 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
|
3766 Faset (v, make_number (i), |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3767 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
|
3768 0)); |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3769 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3770 return v; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3771 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3772 #endif /* DAY_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3773 #ifdef MON_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3774 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
|
3775 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3776 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
|
3777 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
|
3778 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
|
3779 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3780 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3781 for (i = 0; i < 12; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3782 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3783 str = nl_langinfo (months[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3784 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
|
3785 p->contents[i] = |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
3786 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
|
3787 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3788 XSETVECTOR (val, p); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3789 return val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3790 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3791 #endif /* MON_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3792 /* 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
|
3793 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
|
3794 #ifdef PAPER_WIDTH |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3795 else if (EQ (item, Qpaper)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3796 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3797 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
|
3798 make_number (nl_langinfo (PAPER_HEIGHT))); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3799 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3800 #endif /* PAPER_WIDTH */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3801 #endif /* HAVE_LANGINFO_CODESET*/ |
51397 | 3802 return Qnil; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3803 } |
20004 | 3804 |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3805 /* 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
|
3806 Based on code from GNU recode. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3807 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3808 #define MIME_LINE_LENGTH 76 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3809 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3810 #define IS_ASCII(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3811 ((Character) < 128) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3812 #define IS_BASE64(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3813 (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
|
3814 #define IS_BASE64_IGNORABLE(Character) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3815 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3816 || (Character) == '\f' || (Character) == '\r') |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3817 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3818 /* 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
|
3819 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
|
3820 process. */ |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3821 #define READ_QUADRUPLET_BYTE(retval) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3822 do \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3823 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3824 if (i == length) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3825 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3826 if (nchars_return) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3827 *nchars_return = nchars; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3828 return (retval); \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3829 } \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3830 c = from[i++]; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3831 } \ |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3832 while (IS_BASE64_IGNORABLE (c)) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3833 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3834 /* 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
|
3835 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
|
3836 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3837 '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
|
3838 '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
|
3839 '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
|
3840 '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
|
3841 '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
|
3842 '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
|
3843 '8', '9', '+', '/' /* 60-63 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3844 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3845 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3846 /* 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
|
3847 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
|
3848 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3849 -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
|
3850 -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
|
3851 -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
|
3852 -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
|
3853 -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
|
3854 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
|
3855 -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
|
3856 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
|
3857 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
|
3858 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
|
3859 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
|
3860 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
|
3861 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
|
3862 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3863 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3864 /* 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
|
3865 get transformed into four base64 characters. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3866 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3867 .--------. .--------. .--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3868 |aaaaaabb| |bbbbcccc| |ccdddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3869 `--------' `--------' `--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3870 6 2 4 4 2 6 |
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 |00aaaaaa|00bbbbbb|00cccccc|00dddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3873 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3874 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3875 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3876 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| |
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 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3879 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
|
3880 base64 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3881 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3882 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3883 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
|
3884 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
|
3885 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3886 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
|
3887 2, 3, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3888 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
|
3889 Return the length of the encoded text. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3890 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
|
3891 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3892 (beg, end, no_line_break) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3893 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
|
3894 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3895 char *encoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3896 int allength, length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3897 int ibeg, iend, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3898 int old_pos = PT; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3899 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3900 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3901 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3902 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3903 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3904 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3905 move_gap_both (XFASTINT (beg), ibeg); |
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 /* 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
|
3908 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
|
3909 characters, and then we round up. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3910 length = iend - ibeg; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3911 allength = length + length/3 + 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3912 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
|
3913 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3914 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3915 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
|
3916 NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3917 !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
|
3918 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3919 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3920 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3921 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3922 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3923 /* The encoding wasn't possible. */ |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3924 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3925 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
|
3926 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3927 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3928 /* 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
|
3929 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
|
3930 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
|
3931 insert (encoded, encoded_length); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3932 SAFE_FREE (); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3933 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
|
3934 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3935 /* 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
|
3936 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
|
3937 if (old_pos >= XFASTINT (end)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3938 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
|
3939 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
|
3940 old_pos = XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3941 SET_PT (old_pos); |
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 /* 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
|
3944 return make_number (encoded_length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3945 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3946 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3947 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
|
3948 1, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3949 doc: /* Base64-encode STRING and return the result. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3950 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
|
3951 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3952 (string, no_line_break) |
24377
f881dd22ec7d
(Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents:
24334
diff
changeset
|
3953 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
|
3954 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3955 int allength, length, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3956 char *encoded; |
23690 | 3957 Lisp_Object encoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3958 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3959 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3960 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3961 |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3962 /* 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
|
3963 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
|
3964 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
|
3965 length = SBYTES (string); |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3966 allength = length + length/3 + 1; |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3967 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
|
3968 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3969 /* We need to allocate enough room for decoding the text. */ |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3970 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3971 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3972 encoded_length = base64_encode_1 (SDATA (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3973 encoded, length, NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3974 STRING_MULTIBYTE (string)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3975 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3976 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3977 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3978 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3979 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3980 /* The encoding wasn't possible. */ |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3981 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3982 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
|
3983 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3984 |
23690 | 3985 encoded_string = make_unibyte_string (encoded, encoded_length); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3986 SAFE_FREE (); |
23690 | 3987 |
3988 return encoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3989 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3990 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3991 static int |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3992 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
|
3993 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3994 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3995 int length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3996 int line_break; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3997 int multibyte; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3998 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3999 int counter = 0, i = 0; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4000 char *e = to; |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
4001 int c; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4002 unsigned int value; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4003 int bytes; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4004 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4005 while (i < length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4006 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4007 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4008 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4009 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
|
4010 if (c >= 256) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4011 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4012 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4013 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4014 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4015 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4016 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4017 /* Wrap line every 76 characters. */ |
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 (line_break) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4020 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4021 if (counter < MIME_LINE_LENGTH / 4) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4022 counter++; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4023 else |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4024 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4025 *e++ = '\n'; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4026 counter = 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4027 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4028 } |
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 /* Process first byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4031 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4032 *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
|
4033 value = (0x03 & c) << 4; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4034 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4035 /* Process second byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4036 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4037 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4038 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4039 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4040 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4041 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4042 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4043 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4044 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4045 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4046 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4047 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
|
4048 if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
4049 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4050 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4051 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4052 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4053 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4054 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4055 *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
|
4056 value = (0x0f & c) << 2; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4057 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4058 /* Process third byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4059 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4060 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4061 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4062 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4063 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4064 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4065 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4066 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4067 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4068 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4069 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
|
4070 if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
4071 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4072 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4073 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4074 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4075 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4076 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4077 *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
|
4078 *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
|
4079 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4080 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4081 return e - to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4082 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4083 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4084 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4085 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
|
4086 2, 2, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4087 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
|
4088 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
|
4089 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
|
4090 (beg, end) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4091 Lisp_Object beg, end; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4092 { |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4093 int ibeg, iend, length, allength; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4094 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4095 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4096 int decoded_length; |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
4097 int inserted_chars; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4098 int multibyte = !NILP (current_buffer->enable_multibyte_characters); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
4099 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4100 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4101 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4102 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4103 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4104 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4105 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4106 length = iend - ibeg; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4107 |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4108 /* 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
|
4109 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
|
4110 most two bytes. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4111 allength = multibyte ? length * 2 : length; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
4112 SAFE_ALLOCA (decoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4113 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4114 move_gap_both (XFASTINT (beg), ibeg); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4115 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
|
4116 multibyte, &inserted_chars); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4117 if (decoded_length > allength) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4118 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4119 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4120 if (decoded_length < 0) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
4121 { |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
4122 /* The decoding wasn't possible. */ |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
4123 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
4124 error ("Invalid base64 data"); |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
4125 } |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4126 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4127 /* 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
|
4128 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
|
4129 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4130 insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
4131 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
4132 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4133 /* Delete the original text. */ |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4134 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
|
4135 iend + decoded_length, 1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4136 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4137 /* 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
|
4138 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
|
4139 if (old_pos >= XFASTINT (end)) |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
4140 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
|
4141 else if (old_pos > XFASTINT (beg)) |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
4142 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
|
4143 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
|
4144 |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
4145 return make_number (inserted_chars); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4146 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4147 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4148 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
|
4149 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4150 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
|
4151 (string) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4152 Lisp_Object string; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4153 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4154 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4155 int length, decoded_length; |
23690 | 4156 Lisp_Object decoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
4157 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4158 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
4159 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4160 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4161 length = SBYTES (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4162 /* We need to allocate enough room for decoding the text. */ |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
4163 SAFE_ALLOCA (decoded, char *, length); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4164 |
32753
401f661f11d4
2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
32351
diff
changeset
|
4165 /* 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
|
4166 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
|
4167 0, NULL); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4168 if (decoded_length > length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4169 abort (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
4170 else if (decoded_length >= 0) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4171 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
|
4172 else |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
4173 decoded_string = Qnil; |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
4174 |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
4175 SAFE_FREE (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
4176 if (!STRINGP (decoded_string)) |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
4177 error ("Invalid base64 data"); |
23690 | 4178 |
4179 return decoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4180 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4181 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4182 /* 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
|
4183 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
|
4184 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
|
4185 characters in *NCHARS_RETURN. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4186 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4187 static int |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4188 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
|
4189 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4190 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4191 int length; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4192 int multibyte; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4193 int *nchars_return; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4194 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4195 int i = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4196 char *e = to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4197 unsigned char c; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4198 unsigned long value; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4199 int nchars = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4200 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4201 while (1) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4202 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4203 /* Process first byte of a quadruplet. */ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4204 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4205 READ_QUADRUPLET_BYTE (e-to); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4206 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4207 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4208 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4209 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
|
4210 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4211 /* Process second byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4212 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4213 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4214 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4215 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4216 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4217 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
|
4218 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4219 c = (unsigned char) (value >> 16); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4220 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4221 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4222 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4223 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4224 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4225 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4226 /* 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
|
4227 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4228 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4229 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4230 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4231 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4232 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
|
4233 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4234 if (c != '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4235 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4236 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4237 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4238 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4239 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4240 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4241 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
|
4242 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4243 c = (unsigned char) (0xff & value >> 8); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4244 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4245 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4246 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4247 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4248 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4249 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4250 /* Process fourth byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4251 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4252 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4253 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4254 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4255 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4256 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4257 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4258 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4259 value |= base64_char_to_value[c]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4260 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4261 c = (unsigned char) (0xff & value); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4262 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4263 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4264 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4265 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4266 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4267 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4268 } |
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 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4273 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4274 ***** Hash Tables ***** |
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 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4277 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4278 /* Implemented by gerd@gnu.org. This hash table implementation was |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4279 inspired by CMUCL hash tables. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4280 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4281 /* Ideas: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4282 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4283 1. For small tables, association lists are probably faster than |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4284 hash tables because they have lower overhead. |
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 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
|
4287 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
|
4288 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
|
4289 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
|
4290 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
|
4291 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4292 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4293 /* 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
|
4294 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4295 Lisp_Object Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4296 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4297 /* Various symbols. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4298 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4299 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue; |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
4300 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
|
4301 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
|
4302 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4303 /* Function prototypes. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4304 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4305 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
|
4306 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
|
4307 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
|
4308 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
|
4309 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4310 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
|
4311 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4312 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
|
4313 unsigned, Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4314 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
|
4315 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
|
4316 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
|
4317 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4318 Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4319 static unsigned sxhash_string P_ ((unsigned char *, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4320 static unsigned sxhash_list P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4321 static unsigned sxhash_vector P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4322 static unsigned sxhash_bool_vector P_ ((Lisp_Object)); |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4323 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
|
4324 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4325 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4326 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4327 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4328 Utilities |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4329 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4330 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4331 /* 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
|
4332 Lisp_Hash_Table. Otherwise, signal an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4333 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4334 static struct Lisp_Hash_Table * |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4335 check_hash_table (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4336 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4337 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
4338 CHECK_HASH_TABLE (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4339 return XHASH_TABLE (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4340 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4341 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4342 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4343 /* 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
|
4344 number. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4345 |
29979
6fe8f444b6a3
(next_almost_prime): Make it externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
29953
diff
changeset
|
4346 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4347 next_almost_prime (n) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4348 int n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4349 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4350 if (n % 2 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4351 n += 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4352 if (n % 3 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4353 n += 2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4354 if (n % 7 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4355 n += 4; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4356 return n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4357 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4358 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4359 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4360 /* 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
|
4361 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
|
4362 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
|
4363 -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
|
4364 a DEFUN parameter list. */ |
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 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4367 get_key_arg (key, nargs, args, used) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4368 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4369 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4370 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4371 char *used; |
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 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
|
4374 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4375 for (i = 0; i < nargs - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4376 if (!used[i] && EQ (args[i], key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4377 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4378 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4379 if (i >= nargs - 1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4380 i = -1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4381 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4382 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4383 used[i++] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4384 used[i] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4385 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4386 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4387 return i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4388 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4389 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4390 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4391 /* 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
|
4392 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
|
4393 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
|
4394 |
28481
3caab3235bc1
(larger_vector): Make externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
28222
diff
changeset
|
4395 Lisp_Object |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4396 larger_vector (vec, new_size, init) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4397 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4398 int new_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4399 Lisp_Object init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4400 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4401 struct Lisp_Vector *v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4402 int i, old_size; |
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 xassert (VECTORP (vec)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4405 old_size = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4406 xassert (new_size >= old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4407 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4408 v = allocate_vector (new_size); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4409 bcopy (XVECTOR (vec)->contents, v->contents, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4410 old_size * sizeof *v->contents); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4411 for (i = old_size; i < new_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4412 v->contents[i] = init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4413 XSETVECTOR (vec, v); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4414 return vec; |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4417 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4418 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4419 Low-level Functions |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4420 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4421 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4422 /* 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
|
4423 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
|
4424 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4425 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4426 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4427 cmpfn_eql (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4428 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4429 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4430 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4431 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4432 return (FLOATP (key1) |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4433 && FLOATP (key2) |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4434 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4435 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4436 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4437 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4438 /* 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
|
4439 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
|
4440 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4441 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4442 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4443 cmpfn_equal (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4444 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4445 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4446 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4447 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4448 return hash1 == hash2 && !NILP (Fequal (key1, key2)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4449 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4450 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4451 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4452 /* 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
|
4453 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
|
4454 if KEY1 and KEY2 are the same. */ |
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 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4457 cmpfn_user_defined (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4458 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4459 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4460 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4461 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4462 if (hash1 == hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4463 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4464 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
|
4465 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4466 args[0] = h->user_cmp_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4467 args[1] = key1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4468 args[2] = key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4469 return !NILP (Ffuncall (3, args)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4470 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4471 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4472 return 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4473 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4474 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4475 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4476 /* 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
|
4477 `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
|
4478 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4479 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4480 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4481 hashfn_eq (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4482 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4483 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4484 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4485 unsigned hash = XUINT (key) ^ XGCTYPE (key); |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4486 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4487 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4488 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4489 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4490 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4491 /* 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
|
4492 `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
|
4493 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4494 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4495 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4496 hashfn_eql (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4497 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4498 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4499 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4500 unsigned hash; |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4501 if (FLOATP (key)) |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4502 hash = sxhash (key, 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4503 else |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4504 hash = XUINT (key) ^ XGCTYPE (key); |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4505 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4506 return hash; |
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 /* 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
|
4511 `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
|
4512 in a Lisp integer. */ |
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 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4515 hashfn_equal (h, key) |
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 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4519 unsigned hash = sxhash (key, 0); |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4520 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4521 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4522 } |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4525 /* 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
|
4526 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
|
4527 guaranteed to fit in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4528 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4529 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4530 hashfn_user_defined (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4531 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4532 Lisp_Object key; |
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 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
|
4535 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4536 args[0] = h->user_hash_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4537 args[1] = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4538 hash = Ffuncall (2, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4539 if (!INTEGERP (hash)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4540 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4541 list2 (build_string ("Invalid hash code returned from \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4542 user-supplied hash function"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4543 hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4544 return XUINT (hash); |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4548 /* Create and initialize a new hash table. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4549 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4550 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
|
4551 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
|
4552 `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
|
4553 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
|
4554 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4555 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
|
4556 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4557 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
|
4558 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
|
4559 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
|
4560 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
|
4561 REHASH_SIZE. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4562 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4563 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
|
4564 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
|
4565 (table size) is >= REHASH_THRESHOLD. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4566 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4567 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
|
4568 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
|
4569 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4570 Lisp_Object |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4571 make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4572 user_test, user_hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4573 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4574 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4575 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4576 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4577 Lisp_Object table; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4578 int index_size, i, sz; |
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 /* Preconditions. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4581 xassert (SYMBOLP (test)); |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4582 xassert (INTEGERP (size) && XINT (size) >= 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4583 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4584 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4585 xassert (FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4586 && XFLOATINT (rehash_threshold) > 0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4587 && XFLOATINT (rehash_threshold) <= 1.0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4588 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4589 if (XFASTINT (size) == 0) |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4590 size = make_number (1); |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4591 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4592 /* Allocate a table and initialize it. */ |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4593 h = allocate_hash_table (); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4594 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4595 /* Initialize hash table slots. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4596 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
|
4597 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4598 h->test = test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4599 if (EQ (test, Qeql)) |
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 h->cmpfn = cmpfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4602 h->hashfn = hashfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4603 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4604 else if (EQ (test, Qeq)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4605 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4606 h->cmpfn = NULL; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4607 h->hashfn = hashfn_eq; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4608 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4609 else if (EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4610 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4611 h->cmpfn = cmpfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4612 h->hashfn = hashfn_equal; |
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 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4615 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4616 h->user_cmp_function = user_test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4617 h->user_hash_function = user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4618 h->cmpfn = cmpfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4619 h->hashfn = hashfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4620 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4621 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4622 h->weak = weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4623 h->rehash_threshold = rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4624 h->rehash_size = rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4625 h->count = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4626 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
|
4627 h->hash = Fmake_vector (size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4628 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
|
4629 /* 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
|
4630 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
|
4631 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4632 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4633 /* Set up the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4634 for (i = 0; i < sz - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4635 HASH_NEXT (h, i) = make_number (i + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4636 h->next_free = make_number (0); |
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 XSET_HASH_TABLE (table, h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4639 xassert (HASH_TABLE_P (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4640 xassert (XHASH_TABLE (table) == 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 /* 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
|
4643 if (NILP (h->weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4644 h->next_weak = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4645 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4646 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4647 h->next_weak = Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4648 Vweak_hash_tables = table; |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4651 return table; |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4654 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4655 /* 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
|
4656 only the table itself is. */ |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4657 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4658 Lisp_Object |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4659 copy_hash_table (h1) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4660 struct Lisp_Hash_Table *h1; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4661 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4662 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4663 struct Lisp_Hash_Table *h2; |
40769
fa1546836808
(copy_hash_table): Remove unused variable `v'.
Pavel Janík <Pavel@Janik.cz>
parents:
40734
diff
changeset
|
4664 struct Lisp_Vector *next; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4665 |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4666 h2 = allocate_hash_table (); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4667 next = h2->vec_next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4668 bcopy (h1, h2, sizeof *h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4669 h2->vec_next = next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4670 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
|
4671 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
|
4672 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
|
4673 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
|
4674 XSET_HASH_TABLE (table, h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4675 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4676 /* 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
|
4677 if (!NILP (h2->weak)) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4678 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4679 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
|
4680 Vweak_hash_tables = table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4681 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4682 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4683 return table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4684 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4685 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4686 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4687 /* 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
|
4688 because it's already too large, throw an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4689 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4690 static INLINE void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4691 maybe_resize_hash_table (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4692 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4693 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4694 if (NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4695 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4696 int old_size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4697 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
|
4698 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4699 if (INTEGERP (h->rehash_size)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4700 new_size = old_size + XFASTINT (h->rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4701 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4702 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
|
4703 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
|
4704 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
|
4705 (new_size |
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4706 / XFLOATINT (h->rehash_threshold))); |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4707 if (max (index_size, 2 * new_size) > MOST_POSITIVE_FIXNUM) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4708 error ("Hash table too large to resize"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4709 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4710 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
|
4711 h->next = larger_vector (h->next, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4712 h->hash = larger_vector (h->hash, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4713 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4714 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4715 /* 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
|
4716 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
|
4717 maphash faster. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4718 for (i = old_size; i < new_size - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4719 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
|
4720 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4721 if (!NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4722 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4723 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
|
4724 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4725 last = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4726 while (next = HASH_NEXT (h, XFASTINT (last)), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4727 !NILP (next)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4728 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
|
4729 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4730 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4731 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4732 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4733 XSETFASTINT (h->next_free, old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4734 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4735 /* Rehash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4736 for (i = 0; i < old_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4737 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4738 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4739 unsigned hash_code = XUINT (HASH_HASH (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4740 int start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4741 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4742 HASH_INDEX (h, start_of_bucket) = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4743 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4744 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4745 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4746 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4747 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4748 /* 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
|
4749 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
|
4750 matching KEY, or -1 if not found. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4751 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4752 int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4753 hash_lookup (h, key, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4754 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4755 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4756 unsigned *hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4757 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4758 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4759 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4760 Lisp_Object idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4761 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4762 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4763 if (hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4764 *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
|
4765 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4766 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4767 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4768 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4769 /* 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
|
4770 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4771 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4772 int i = XFASTINT (idx); |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4773 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
|
4774 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4775 && 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
|
4776 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4777 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4778 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4779 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4780 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4781 return NILP (idx) ? -1 : XFASTINT (idx); |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4784 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4785 /* 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
|
4786 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
|
4787 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
|
4788 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4789 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4790 hash_put (h, key, value, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4791 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4792 Lisp_Object key, value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4793 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4794 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4795 int start_of_bucket, i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4796 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4797 xassert ((hash & ~INTMASK) == 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4798 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4799 /* Increment count after resizing because resizing may fail. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4800 maybe_resize_hash_table (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4801 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
|
4802 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4803 /* Store key/value in the key_and_value vector. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4804 i = XFASTINT (h->next_free); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4805 h->next_free = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4806 HASH_KEY (h, i) = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4807 HASH_VALUE (h, i) = value; |
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 /* Remember its hash code. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4810 HASH_HASH (h, i) = make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4811 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4812 /* Add new entry to its collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4813 start_of_bucket = hash % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4814 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4815 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
|
4816 return i; |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4819 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4820 /* 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
|
4821 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4822 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4823 hash_remove (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4824 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4825 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4826 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4827 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4828 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4829 Lisp_Object idx, prev; |
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 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4832 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4833 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4834 prev = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4835 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4836 /* 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
|
4837 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4838 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4839 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4840 |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4841 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
|
4842 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4843 && 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
|
4844 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
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 /* Take entry out of collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4847 if (NILP (prev)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4848 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4849 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4850 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4851 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4852 /* 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
|
4853 the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4854 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
|
4855 HASH_NEXT (h, i) = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4856 h->next_free = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4857 h->count = make_number (XFASTINT (h->count) - 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4858 xassert (XINT (h->count) >= 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4859 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4860 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4861 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4862 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4863 prev = idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4864 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4865 } |
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 |
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 /* Clear hash table H. */ |
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 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4873 hash_clear (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4874 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4875 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4876 if (XFASTINT (h->count) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4877 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4878 int i, size = HASH_TABLE_SIZE (h); |
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 for (i = 0; i < size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4881 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4882 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
|
4883 HASH_KEY (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4884 HASH_VALUE (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4885 HASH_HASH (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4886 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4887 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4888 for (i = 0; i < XVECTOR (h->index)->size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4889 XVECTOR (h->index)->contents[i] = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4890 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4891 h->next_free = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4892 h->count = make_number (0); |
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 } |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4897 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4898 /************************************************************************ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4899 Weak Hash Tables |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4900 ************************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4901 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4902 /* 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
|
4903 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
|
4904 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
|
4905 non-zero if anything was marked. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4906 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4907 static int |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4908 sweep_weak_table (h, remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4909 struct Lisp_Hash_Table *h; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4910 int remove_entries_p; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4911 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4912 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
|
4913 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4914 n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4915 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
|
4916 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4917 for (bucket = 0; bucket < n; ++bucket) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4918 { |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4919 Lisp_Object idx, next, prev; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4920 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4921 /* Follow collision chain, removing entries that |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4922 don't survive this garbage collection. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4923 prev = Qnil; |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4924 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
|
4925 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4926 int i = XFASTINT (idx); |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4927 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
|
4928 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
|
4929 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
|
4930 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4931 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
|
4932 remove_p = !key_known_to_survive_p; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4933 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
|
4934 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
|
4935 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
|
4936 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
|
4937 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
|
4938 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
|
4939 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4940 abort (); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4941 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4942 next = HASH_NEXT (h, i); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4943 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4944 if (remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4945 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4946 if (remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4947 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4948 /* Take out of collision chain. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4949 if (GC_NILP (prev)) |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4950 HASH_INDEX (h, bucket) = next; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4951 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4952 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
|
4953 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4954 /* Add to free list. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4955 HASH_NEXT (h, i) = h->next_free; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4956 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
|
4957 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4958 /* Clear key, value, and hash. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4959 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4960 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
|
4961 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4962 h->count = make_number (XFASTINT (h->count) - 1); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4963 } |
59630
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4964 else |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4965 { |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4966 prev = idx; |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4967 } |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4968 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4969 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4970 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4971 if (!remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4972 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4973 /* 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
|
4974 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
|
4975 { |
51768
31f2f6a2df06
(sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51397
diff
changeset
|
4976 mark_object (HASH_KEY (h, i)); |
30007
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4977 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4978 } |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4979 |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4980 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
|
4981 { |
51768
31f2f6a2df06
(sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51397
diff
changeset
|
4982 mark_object (HASH_VALUE (h, i)); |
30007
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4983 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4984 } |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4985 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4986 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4987 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4988 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4989 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4990 return marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4991 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4992 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4993 /* 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
|
4994 current garbage collection. Remove weak tables that don't survive |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4995 from Vweak_hash_tables. Called from gc_sweep. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4996 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4997 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4998 sweep_weak_hash_tables () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4999 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5000 Lisp_Object table, used, next; |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5001 struct Lisp_Hash_Table *h; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5002 int marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5003 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5004 /* 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
|
5005 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
|
5006 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
|
5007 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
|
5008 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
|
5009 one finds that it shouldn't. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5010 do |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5011 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5012 marked = 0; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5013 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
|
5014 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5015 h = XHASH_TABLE (table); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5016 if (h->size & ARRAY_MARK_FLAG) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5017 marked |= sweep_weak_table (h, 0); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5018 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5019 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5020 while (marked); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5021 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5022 /* 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
|
5023 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
|
5024 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5025 h = XHASH_TABLE (table); |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5026 next = h->next_weak; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5027 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5028 if (h->size & ARRAY_MARK_FLAG) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5029 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5030 /* TABLE is marked as used. Sweep its contents. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5031 if (XFASTINT (h->count) > 0) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
5032 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
|
5033 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5034 /* 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
|
5035 h->next_weak = used; |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5036 used = table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5037 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5038 } |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5039 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
5040 Vweak_hash_tables = used; |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5043 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5044 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5045 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5046 Hash Code Computation |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5047 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5048 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5049 /* Maximum depth up to which to dive into Lisp structures. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5050 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5051 #define SXHASH_MAX_DEPTH 3 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5052 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5053 /* 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
|
5054 account. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5055 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5056 #define SXHASH_MAX_LEN 7 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5057 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5058 /* Combine two integers X and Y for hashing. */ |
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 #define SXHASH_COMBINE(X, Y) \ |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
5061 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5062 + (unsigned)(Y)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5063 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5064 |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
5065 /* 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
|
5066 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
|
5067 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5068 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5069 sxhash_string (ptr, len) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5070 unsigned char *ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5071 int len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5072 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5073 unsigned char *p = ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5074 unsigned char *end = p + len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5075 unsigned char c; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5076 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5077 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5078 while (p != end) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5079 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5080 c = *p++; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5081 if (c >= 0140) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5082 c -= 40; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5083 hash = ((hash << 3) + (hash >> 28) + c); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5084 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5085 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
5086 return hash & INTMASK; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5087 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5088 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5089 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5090 /* 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
|
5091 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
|
5092 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5093 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5094 sxhash_list (list, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5095 Lisp_Object list; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5096 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5097 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5098 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5099 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
|
5100 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5101 if (depth < SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5102 for (i = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5103 CONSP (list) && i < SXHASH_MAX_LEN; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5104 list = XCDR (list), ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5105 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5106 unsigned hash2 = sxhash (XCAR (list), depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5107 hash = SXHASH_COMBINE (hash, hash2); |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5110 return 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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5114 /* 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
|
5115 the Lisp structure. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5116 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5117 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5118 sxhash_vector (vec, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5119 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5120 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5121 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5122 unsigned hash = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5123 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5124 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5125 n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5126 for (i = 0; i < n; ++i) |
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 unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5129 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5130 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5131 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5132 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5133 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5134 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5135 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5136 /* Return a hash for bool-vector VECTOR. */ |
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 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5139 sxhash_bool_vector (vec) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5140 Lisp_Object vec; |
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 unsigned hash = XBOOL_VECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5143 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5144 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5145 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5146 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5147 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5148 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5149 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5150 } |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5153 /* Return a hash code for OBJ. DEPTH is the current depth in the Lisp |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
5154 structure. Value is an unsigned integer clipped to INTMASK. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5155 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5156 unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5157 sxhash (obj, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5158 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5159 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5160 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5161 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5162 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5163 if (depth > SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5164 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
|
5165 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5166 switch (XTYPE (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5167 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5168 case Lisp_Int: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5169 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5170 break; |
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 case Lisp_Misc: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5173 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5174 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5175 |
57988
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
5176 case Lisp_Symbol: |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
5177 obj = SYMBOL_NAME (obj); |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
5178 /* Fall through. */ |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
5179 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5180 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
|
5181 hash = sxhash_string (SDATA (obj), SCHARS (obj)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5182 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5183 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5184 /* This can be everything from a vector to an overlay. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5185 case Lisp_Vectorlike: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5186 if (VECTORP (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5187 /* 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
|
5188 they are `eq', except for strings and bit-vectors. In |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5189 Emacs, this works differently. We have to compare element |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5190 by element. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5191 hash = sxhash_vector (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5192 else if (BOOL_VECTOR_P (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5193 hash = sxhash_bool_vector (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5194 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5195 /* 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
|
5196 address as hash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5197 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5198 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5199 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5200 case Lisp_Cons: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5201 hash = sxhash_list (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5202 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5203 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5204 case Lisp_Float: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5205 { |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5206 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
|
5207 unsigned char *e = p + sizeof XFLOAT_DATA (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5208 for (hash = 0; p < e; ++p) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5209 hash = SXHASH_COMBINE (hash, *p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5210 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5211 } |
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 default: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5214 abort (); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5215 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5216 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
5217 return hash & INTMASK; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5218 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5219 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5220 |
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 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5223 Lisp Interface |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5224 ***********************************************************************/ |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5227 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
|
5228 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
|
5229 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5230 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5231 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5232 unsigned hash = sxhash (obj, 0);; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5233 return make_number (hash); |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5237 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
|
5238 doc: /* Create and return a new hash table. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5239 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5240 Arguments are specified as keyword/argument pairs. The following |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5241 arguments are defined: |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5242 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5243 :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
|
5244 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
|
5245 `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
|
5246 `define-hash-table-test'. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5247 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5248 :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
|
5249 Default is 65. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5250 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5251 :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
|
5252 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
|
5253 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
|
5254 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
|
5255 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5256 :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
|
5257 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
|
5258 table. Default is 0.8. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5259 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5260 :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
|
5261 `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
|
5262 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
|
5263 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
|
5264 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
|
5265 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
|
5266 is nil. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
5267 |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
5268 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
|
5269 (nargs, args) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5270 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5271 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5272 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5273 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5274 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5275 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5276 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5277 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5278 /* 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
|
5279 have been consumed. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5280 used = (char *) alloca (nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5281 bzero (used, nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5282 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5283 /* See if there's a `:test TEST' among the arguments. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5284 i = get_key_arg (QCtest, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5285 test = i < 0 ? Qeql : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5286 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5287 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5288 /* See if it is a user-defined test. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5289 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
|
5290 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5291 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
|
5292 if (!CONSP (prop) || !CONSP (XCDR (prop))) |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5293 Fsignal (Qerror, list2 (build_string ("Invalid hash table test"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5294 test)); |
40734
95dd892ad5e3
(Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
5295 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
|
5296 user_hash = XCAR (XCDR (prop)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5297 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5298 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5299 user_test = user_hash = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5300 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5301 /* See if there's a `:size SIZE' argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5302 i = get_key_arg (QCsize, nargs, args, used); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5303 size = i < 0 ? Qnil : args[i]; |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5304 if (NILP (size)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5305 size = make_number (DEFAULT_HASH_SIZE); |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5306 else if (!INTEGERP (size) || XINT (size) < 0) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5307 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5308 list2 (build_string ("Invalid hash table size"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5309 size)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5310 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5311 /* Look for `:rehash-size SIZE'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5312 i = get_key_arg (QCrehash_size, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5313 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
|
5314 if (!NUMBERP (rehash_size) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5315 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5316 || XFLOATINT (rehash_size) <= 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5317 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5318 list2 (build_string ("Invalid hash table rehash size"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5319 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
|
5320 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5321 /* Look for `:rehash-threshold THRESHOLD'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5322 i = get_key_arg (QCrehash_threshold, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5323 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
|
5324 if (!FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5325 || XFLOATINT (rehash_threshold) <= 0.0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5326 || XFLOATINT (rehash_threshold) > 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5327 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5328 list2 (build_string ("Invalid hash table rehash threshold"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5329 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
|
5330 |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5331 /* Look for `:weakness WEAK'. */ |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5332 i = get_key_arg (QCweakness, nargs, args, used); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5333 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
|
5334 if (EQ (weak, Qt)) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5335 weak = Qkey_and_value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5336 if (!NILP (weak) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5337 && !EQ (weak, Qkey) |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5338 && !EQ (weak, Qvalue) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5339 && !EQ (weak, Qkey_or_value) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5340 && !EQ (weak, Qkey_and_value)) |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5341 Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5342 weak)); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5343 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5344 /* 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
|
5345 for (i = 0; i < nargs; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5346 if (!used[i]) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5347 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5348 list2 (build_string ("Invalid argument list"), args[i])); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5349 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5350 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
|
5351 user_test, user_hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5352 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5353 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5354 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5355 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
|
5356 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
|
5357 (table) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5358 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5359 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5360 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
|
5361 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5362 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5363 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5364 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
|
5365 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
|
5366 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5367 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5368 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5369 return check_hash_table (table)->count; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5370 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5371 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5372 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5373 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5374 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
|
5375 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
|
5376 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5377 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5378 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5379 return check_hash_table (table)->rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5380 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5381 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5382 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5383 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5384 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
|
5385 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
|
5386 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5387 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5388 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5389 return check_hash_table (table)->rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5390 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5391 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5392 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5393 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
|
5394 doc: /* Return the size of TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5395 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
|
5396 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
|
5397 without need for resizing. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5398 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5399 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5400 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5401 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5402 return make_number (HASH_TABLE_SIZE (h)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5403 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5404 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5405 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5406 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
|
5407 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
|
5408 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5409 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5410 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5411 return check_hash_table (table)->test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5412 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5413 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5414 |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5415 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
|
5416 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5417 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
|
5418 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5419 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5420 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5421 return check_hash_table (table)->weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5422 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5423 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5424 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5425 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
|
5426 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
|
5427 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5428 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5429 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5430 return HASH_TABLE_P (obj) ? Qt : Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5431 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5432 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5433 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5434 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
|
5435 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
|
5436 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5437 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5438 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5439 hash_clear (check_hash_table (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5440 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5441 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5442 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5443 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5444 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
|
5445 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
|
5446 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
|
5447 (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
|
5448 Lisp_Object key, table, dflt; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5449 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5450 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5451 int i = hash_lookup (h, key, NULL); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5452 return i >= 0 ? HASH_VALUE (h, i) : dflt; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5453 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5454 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5455 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5456 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
|
5457 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
|
5458 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
|
5459 VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5460 (key, value, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
5461 Lisp_Object key, value, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5462 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5463 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5464 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5465 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5466 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5467 i = hash_lookup (h, key, &hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5468 if (i >= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5469 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5470 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5471 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
|
5472 |
29991
fff5fd809d11
(Fputhash): Return `value' rather than nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29979
diff
changeset
|
5473 return value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5474 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5475 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5476 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5477 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
|
5478 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
|
5479 (key, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
5480 Lisp_Object key, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5481 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5482 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5483 hash_remove (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5484 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5485 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5486 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5487 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5488 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
|
5489 doc: /* Call FUNCTION for all entries in hash table TABLE. |
63173
66bf26afd9c6
(Fmemq, Fmaphash): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
62950
diff
changeset
|
5490 FUNCTION is called with two arguments, KEY and VALUE. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5491 (function, table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5492 Lisp_Object function, table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5493 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5494 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5495 Lisp_Object args[3]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5496 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5497 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5498 for (i = 0; i < HASH_TABLE_SIZE (h); ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5499 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5500 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5501 args[0] = function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5502 args[1] = HASH_KEY (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5503 args[2] = HASH_VALUE (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5504 Ffuncall (3, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5505 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5506 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5507 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5508 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5509 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5510 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5511 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5512 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
|
5513 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
|
5514 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5515 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
|
5516 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
|
5517 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5518 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
|
5519 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
|
5520 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
|
5521 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
|
5522 including negative integers. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5523 (name, test, hash) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5524 Lisp_Object name, test, hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5525 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5526 return Fput (name, Qhash_table_test, list2 (test, hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5527 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5528 |
28965 | 5529 |
34050 | 5530 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5531 /************************************************************************ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5532 MD5 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5533 ************************************************************************/ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5534 |
34050 | 5535 #include "md5.h" |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5536 #include "coding.h" |
34050 | 5537 |
5538 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
|
5539 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
|
5540 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5541 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
|
5542 algorithm to calculate it is defined in RFC 1321. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5543 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5544 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
|
5545 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
|
5546 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
|
5547 OBJECT. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5548 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5549 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
|
5550 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
|
5551 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
|
5552 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
|
5553 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
|
5554 file. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5555 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5556 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
|
5557 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
|
5558 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
|
5559 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5560 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
|
5561 command `prefer-coding-system') is used. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5562 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5563 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
|
5564 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
|
5565 (object, start, end, coding_system, noerror) |
34050 | 5566 Lisp_Object object, start, end, coding_system, noerror; |
5567 { | |
5568 unsigned char digest[16]; | |
5569 unsigned char value[33]; | |
5570 int i; | |
5571 int size; | |
5572 int size_byte = 0; | |
5573 int start_char = 0, end_char = 0; | |
5574 int start_byte = 0, end_byte = 0; | |
5575 register int b, e; | |
5576 register struct buffer *bp; | |
5577 int temp; | |
5578 | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5579 if (STRINGP (object)) |
34050 | 5580 { |
5581 if (NILP (coding_system)) | |
5582 { | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5583 /* 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
|
5584 |
34050 | 5585 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
|
5586 /* 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
|
5587 coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list)); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5588 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5589 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5590 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5591 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5592 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
|
5593 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5594 /* Invalid coding system. */ |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5595 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5596 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5597 coding_system = Qraw_text; |
34050 | 5598 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5599 while (1) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5600 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); |
34050 | 5601 } |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5602 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5603 if (STRING_MULTIBYTE (object)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5604 object = code_convert_string1 (object, coding_system, Qnil, 1); |
34050 | 5605 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
5606 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
|
5607 size_byte = SBYTES (object); |
34050 | 5608 |
5609 if (!NILP (start)) | |
5610 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5611 CHECK_NUMBER (start); |
34050 | 5612 |
5613 start_char = XINT (start); | |
5614 | |
5615 if (start_char < 0) | |
5616 start_char += size; | |
5617 | |
5618 start_byte = string_char_to_byte (object, start_char); | |
5619 } | |
5620 | |
5621 if (NILP (end)) | |
5622 { | |
5623 end_char = size; | |
5624 end_byte = size_byte; | |
5625 } | |
5626 else | |
5627 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5628 CHECK_NUMBER (end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5629 |
34050 | 5630 end_char = XINT (end); |
5631 | |
5632 if (end_char < 0) | |
5633 end_char += size; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5634 |
34050 | 5635 end_byte = string_char_to_byte (object, end_char); |
5636 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5637 |
34050 | 5638 if (!(0 <= start_char && start_char <= end_char && end_char <= size)) |
5639 args_out_of_range_3 (object, make_number (start_char), | |
5640 make_number (end_char)); | |
5641 } | |
5642 else | |
5643 { | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5644 struct buffer *prev = current_buffer; |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5645 |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5646 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5647 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5648 CHECK_BUFFER (object); |
34050 | 5649 |
5650 bp = XBUFFER (object); | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5651 if (bp != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5652 set_buffer_internal (bp); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5653 |
34050 | 5654 if (NILP (start)) |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5655 b = BEGV; |
34050 | 5656 else |
5657 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5658 CHECK_NUMBER_COERCE_MARKER (start); |
34050 | 5659 b = XINT (start); |
5660 } | |
5661 | |
5662 if (NILP (end)) | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5663 e = ZV; |
34050 | 5664 else |
5665 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5666 CHECK_NUMBER_COERCE_MARKER (end); |
34050 | 5667 e = XINT (end); |
5668 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5669 |
34050 | 5670 if (b > e) |
5671 temp = b, b = e, e = temp; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5672 |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5673 if (!(BEGV <= b && e <= ZV)) |
34050 | 5674 args_out_of_range (start, end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5675 |
34050 | 5676 if (NILP (coding_system)) |
5677 { | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5678 /* 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
|
5679 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
|
5680 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5681 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
|
5682 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
|
5683 else |
34050 | 5684 { |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5685 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
|
5686 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5687 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
|
5688 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5689 || 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
|
5690 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5691 coding_system = Qnil; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5692 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
|
5693 force_raw_text = 1; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5694 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5695 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5696 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
|
5697 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5698 /* 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
|
5699 Lisp_Object args[4], val; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5700 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5701 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
|
5702 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
|
5703 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
|
5704 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
|
5705 coding_system = XCDR (val); |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5706 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5707 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5708 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5709 && !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
|
5710 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5711 /* 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
|
5712 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
|
5713 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
|
5714 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5715 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5716 if (!force_raw_text |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5717 && !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
|
5718 /* 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
|
5719 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
|
5720 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
|
5721 coding_system, Qnil); |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5722 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5723 if (force_raw_text) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5724 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5725 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5726 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5727 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
|
5728 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5729 /* Invalid coding system. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5730 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5731 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5732 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5733 else |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5734 while (1) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5735 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); |
34050 | 5736 } |
5737 } | |
5738 | |
5739 object = make_buffer_string (b, e, 0); | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5740 if (prev != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5741 set_buffer_internal (prev); |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5742 /* Discard the unwind protect for recovering the current |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5743 buffer. */ |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5744 specpdl_ptr--; |
34050 | 5745 |
5746 if (STRING_MULTIBYTE (object)) | |
5747 object = code_convert_string1 (object, coding_system, Qnil, 1); | |
5748 } | |
5749 | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5750 md5_buffer (SDATA (object) + start_byte, |
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5751 SBYTES (object) - (size_byte - end_byte), |
34050 | 5752 digest); |
5753 | |
5754 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
|
5755 sprintf (&value[2 * i], "%02x", digest[i]); |
34050 | 5756 value[32] = '\0'; |
5757 | |
5758 return make_string (value, 32); | |
5759 } | |
5760 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5761 |
21514 | 5762 void |
211 | 5763 syms_of_fns () |
5764 { | |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5765 /* Hash table stuff. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5766 Qhash_table_p = intern ("hash-table-p"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5767 staticpro (&Qhash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5768 Qeq = intern ("eq"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5769 staticpro (&Qeq); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5770 Qeql = intern ("eql"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5771 staticpro (&Qeql); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5772 Qequal = intern ("equal"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5773 staticpro (&Qequal); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5774 QCtest = intern (":test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5775 staticpro (&QCtest); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5776 QCsize = intern (":size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5777 staticpro (&QCsize); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5778 QCrehash_size = intern (":rehash-size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5779 staticpro (&QCrehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5780 QCrehash_threshold = intern (":rehash-threshold"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5781 staticpro (&QCrehash_threshold); |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5782 QCweakness = intern (":weakness"); |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5783 staticpro (&QCweakness); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5784 Qkey = intern ("key"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5785 staticpro (&Qkey); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5786 Qvalue = intern ("value"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5787 staticpro (&Qvalue); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5788 Qhash_table_test = intern ("hash-table-test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5789 staticpro (&Qhash_table_test); |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5790 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
|
5791 staticpro (&Qkey_or_value); |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5792 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
|
5793 staticpro (&Qkey_and_value); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5794 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5795 defsubr (&Ssxhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5796 defsubr (&Smake_hash_table); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5797 defsubr (&Scopy_hash_table); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5798 defsubr (&Shash_table_count); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5799 defsubr (&Shash_table_rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5800 defsubr (&Shash_table_rehash_threshold); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5801 defsubr (&Shash_table_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5802 defsubr (&Shash_table_test); |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5803 defsubr (&Shash_table_weakness); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5804 defsubr (&Shash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5805 defsubr (&Sclrhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5806 defsubr (&Sgethash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5807 defsubr (&Sputhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5808 defsubr (&Sremhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5809 defsubr (&Smaphash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5810 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
|
5811 |
211 | 5812 Qstring_lessp = intern ("string-lessp"); |
5813 staticpro (&Qstring_lessp); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5814 Qprovide = intern ("provide"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5815 staticpro (&Qprovide); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5816 Qrequire = intern ("require"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5817 staticpro (&Qrequire); |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
5818 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
|
5819 staticpro (&Qyes_or_no_p_history); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
5820 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
|
5821 staticpro (&Qcursor_in_echo_area); |
20004 | 5822 Qwidget_type = intern ("widget-type"); |
5823 staticpro (&Qwidget_type); | |
211 | 5824 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5825 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
|
5826 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
|
5827 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5828 require_nesting_list = Qnil; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5829 staticpro (&require_nesting_list); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5830 |
14486
3c4ba112108e
(syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents:
14456
diff
changeset
|
5831 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
|
5832 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5833 DEFVAR_LISP ("features", &Vfeatures, |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5834 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
|
5835 Used by `featurep' and `require', and altered by `provide'. */); |
64774
369c84bf493f
(syms_of_fns): Add `emacs' to features.
Richard M. Stallman <rms@gnu.org>
parents:
64770
diff
changeset
|
5836 Vfeatures = Fcons (intern ("emacs"), Qnil); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5837 Qsubfeatures = intern ("subfeatures"); |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5838 staticpro (&Qsubfeatures); |
211 | 5839 |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5840 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5841 Qcodeset = intern ("codeset"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5842 staticpro (&Qcodeset); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5843 Qdays = intern ("days"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5844 staticpro (&Qdays); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5845 Qmonths = intern ("months"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5846 staticpro (&Qmonths); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5847 Qpaper = intern ("paper"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5848 staticpro (&Qpaper); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5849 #endif /* HAVE_LANGINFO_CODESET */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5850 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5851 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
|
5852 doc: /* *Non-nil means mouse commands use dialog boxes to ask questions. |
44712 | 5853 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
|
5854 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
|
5855 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
|
5856 |
53189
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
5857 DEFVAR_BOOL ("use-file-dialog", &use_file_dialog, |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
5858 doc: /* *Non-nil means mouse commands use a file dialog to ask for files. |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
5859 This applies to commands from menus and tool bar buttons. The value of |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
5860 `use-dialog-box' takes precedence over this variable, so a file dialog is only |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
5861 used if both `use-dialog-box' and this variable are non-nil. */); |
2c1d6f1a791e
Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53159
diff
changeset
|
5862 use_file_dialog = 1; |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
5863 |
211 | 5864 defsubr (&Sidentity); |
5865 defsubr (&Srandom); | |
5866 defsubr (&Slength); | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
5867 defsubr (&Ssafe_length); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
5868 defsubr (&Sstring_bytes); |
211 | 5869 defsubr (&Sstring_equal); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
5870 defsubr (&Scompare_strings); |
211 | 5871 defsubr (&Sstring_lessp); |
5872 defsubr (&Sappend); | |
5873 defsubr (&Sconcat); | |
5874 defsubr (&Svconcat); | |
5875 defsubr (&Scopy_sequence); | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5876 defsubr (&Sstring_make_multibyte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5877 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
|
5878 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
|
5879 defsubr (&Sstring_as_unibyte); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
5880 defsubr (&Sstring_to_multibyte); |
211 | 5881 defsubr (&Scopy_alist); |
5882 defsubr (&Ssubstring); | |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5883 defsubr (&Ssubstring_no_properties); |
211 | 5884 defsubr (&Snthcdr); |
5885 defsubr (&Snth); | |
5886 defsubr (&Selt); | |
5887 defsubr (&Smember); | |
5888 defsubr (&Smemq); | |
5889 defsubr (&Sassq); | |
5890 defsubr (&Sassoc); | |
5891 defsubr (&Srassq); | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
5892 defsubr (&Srassoc); |
211 | 5893 defsubr (&Sdelq); |
414 | 5894 defsubr (&Sdelete); |
211 | 5895 defsubr (&Snreverse); |
5896 defsubr (&Sreverse); | |
5897 defsubr (&Ssort); | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5898 defsubr (&Splist_get); |
211 | 5899 defsubr (&Sget); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5900 defsubr (&Splist_put); |
211 | 5901 defsubr (&Sput); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5902 defsubr (&Slax_plist_get); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5903 defsubr (&Slax_plist_put); |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
5904 defsubr (&Seql); |
211 | 5905 defsubr (&Sequal); |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
5906 defsubr (&Sequal_including_properties); |
211 | 5907 defsubr (&Sfillarray); |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
5908 defsubr (&Sclear_string); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
5909 defsubr (&Schar_table_subtype); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5910 defsubr (&Schar_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5911 defsubr (&Sset_char_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5912 defsubr (&Schar_table_extra_slot); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5913 defsubr (&Sset_char_table_extra_slot); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
5914 defsubr (&Schar_table_range); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5915 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
|
5916 defsubr (&Sset_char_table_default); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
5917 defsubr (&Soptimize_char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5918 defsubr (&Smap_char_table); |
211 | 5919 defsubr (&Snconc); |
5920 defsubr (&Smapcar); | |
28666 | 5921 defsubr (&Smapc); |
211 | 5922 defsubr (&Smapconcat); |
5923 defsubr (&Sy_or_n_p); | |
5924 defsubr (&Syes_or_no_p); | |
5925 defsubr (&Sload_average); | |
5926 defsubr (&Sfeaturep); | |
5927 defsubr (&Srequire); | |
5928 defsubr (&Sprovide); | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
5929 defsubr (&Splist_member); |
20004 | 5930 defsubr (&Swidget_put); |
5931 defsubr (&Swidget_get); | |
5932 defsubr (&Swidget_apply); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5933 defsubr (&Sbase64_encode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5934 defsubr (&Sbase64_decode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5935 defsubr (&Sbase64_encode_string); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5936 defsubr (&Sbase64_decode_string); |
34050 | 5937 defsubr (&Smd5); |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
5938 defsubr (&Slocale_info); |
211 | 5939 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5940 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5941 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5942 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5943 init_fns () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5944 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5945 Vweak_hash_tables = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5946 } |
52401 | 5947 |
5948 /* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31 | |
5949 (do not change this comment) */ |