Mercurial > emacs
annotate src/fns.c @ 56207:b5f852992d97
(Saving Buffers): Correct description of `write-contents-functions'.
author | Lars Hansen <larsh@soem.dk> |
---|---|
date | Wed, 23 Jun 2004 14:37:27 +0000 |
parents | 1305e0463707 |
children | 98133cccc0cc |
rev | line source |
---|---|
211 | 1 /* Random utility Lisp functions. |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 03, 2004 |
34050 | 3 Free Software Foundation, Inc. |
211 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 it under the terms of the GNU General Public License as published by | |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
9 the Free Software Foundation; either version 2, or (at your option) |
211 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with GNU Emacs; see the file COPYING. If not, write to | |
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14097
diff
changeset
|
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14097
diff
changeset
|
20 Boston, MA 02111-1307, USA. */ |
211 | 21 |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4616
diff
changeset
|
22 #include <config.h> |
211 | 23 |
21514 | 24 #ifdef HAVE_UNISTD_H |
25 #include <unistd.h> | |
26 #endif | |
21841
12c75f0ef578
Include <time.h> for time.
Andreas Schwab <schwab@suse.de>
parents:
21810
diff
changeset
|
27 #include <time.h> |
21514 | 28 |
50301
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
29 #ifndef MAC_OSX |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
30 /* On Mac OS X, defining this conflicts with precompiled headers. */ |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
31 |
211 | 32 /* Note on some machines this defines `vector' as a typedef, |
33 so make sure we don't use that name in this file. */ | |
34 #undef vector | |
35 #define vector ***** | |
50301
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
36 |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
37 #endif /* ! MAC_OSX */ |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
38 |
211 | 39 #include "lisp.h" |
40 #include "commands.h" | |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
41 #include "charset.h" |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
42 #include "coding.h" |
211 | 43 #include "buffer.h" |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
44 #include "keyboard.h" |
39697
0b986bb45526
Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39682
diff
changeset
|
45 #include "keymap.h" |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
46 #include "intervals.h" |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
47 #include "frame.h" |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
48 #include "window.h" |
37319 | 49 #include "blockinput.h" |
21810
15f5abff4d9b
[HAVE_MENUS]: Include xterm.h only if HAVE_X_WINDOWS.
Richard M. Stallman <rms@gnu.org>
parents:
21791
diff
changeset
|
50 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS) |
21514 | 51 #include "xterm.h" |
52 #endif | |
211 | 53 |
12062 | 54 #ifndef NULL |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
55 #define NULL ((POINTER_TYPE *)0) |
12062 | 56 #endif |
57 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
58 /* Nonzero enables use of dialog boxes for questions |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
59 asked by mouse commands. */ |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
60 int use_dialog_box; |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
61 |
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
|
62 /* 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
|
63 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
|
64 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
|
65 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
66 extern int minibuffer_auto_raise; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
67 extern Lisp_Object minibuf_window; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
68 extern Lisp_Object Vlocale_coding_system; |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
69 |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
70 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
|
71 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
|
72 Lisp_Object Qcursor_in_echo_area; |
20004 | 73 Lisp_Object Qwidget_type; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
74 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; |
211 | 75 |
23051
18ed8d6b11e5
(Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents:
22853
diff
changeset
|
76 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
|
77 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
78 static int internal_equal (); |
21580
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
79 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
80 extern long get_random (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
81 extern void seed_random (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
82 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
83 #ifndef HAVE_UNISTD_H |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
84 extern long time (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
85 #endif |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
86 |
211 | 87 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
41006 | 88 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
|
89 (arg) |
211 | 90 Lisp_Object arg; |
91 { | |
92 return arg; | |
93 } | |
94 | |
95 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
|
96 doc: /* Return a pseudo-random number. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
97 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
|
98 On most systems, this is 29 bits' worth. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
99 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
|
100 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
|
101 (n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
102 Lisp_Object n; |
211 | 103 { |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
104 EMACS_INT val; |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
105 Lisp_Object lispy_val; |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
106 unsigned long denominator; |
211 | 107 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
108 if (EQ (n, Qt)) |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
109 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
|
110 if (NATNUMP (n) && XFASTINT (n) != 0) |
211 | 111 { |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
112 /* 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
|
113 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
|
114 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
|
115 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
|
116 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
|
117 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
|
118 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
|
119 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
120 do |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
121 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
|
122 while (val >= XFASTINT (n)); |
211 | 123 } |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
124 else |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
125 val = get_random (); |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
126 XSETINT (lispy_val, val); |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
127 return lispy_val; |
211 | 128 } |
129 | |
130 /* Random data-structure functions */ | |
131 | |
132 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
|
133 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
|
134 A byte-code function object is also allowed. |
47762 | 135 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
|
136 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
|
137 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
|
138 (sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
139 register Lisp_Object sequence; |
211 | 140 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
141 register Lisp_Object val; |
211 | 142 register int i; |
143 | |
144 retry: | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
145 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
|
146 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
|
147 else if (VECTORP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
148 XSETFASTINT (val, XVECTOR (sequence)->size); |
50461
6a4e89f0d078
(Flength): Return SUB_CHAR_TABLE_ORDINARY_SLOTS for sub char tables.
Juanma Barranquero <lekktu@gmail.com>
parents:
50301
diff
changeset
|
149 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
|
150 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
|
151 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
|
152 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
|
153 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
|
154 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
|
155 else if (COMPILEDP (sequence)) |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
156 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
|
157 else if (CONSP (sequence)) |
211 | 158 { |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
159 i = 0; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
160 while (CONSP (sequence)) |
211 | 161 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
162 sequence = XCDR (sequence); |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
163 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
164 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
165 if (!CONSP (sequence)) |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
166 break; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
167 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
168 sequence = XCDR (sequence); |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
169 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
170 QUIT; |
211 | 171 } |
172 | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
173 if (!NILP (sequence)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
174 wrong_type_argument (Qlistp, sequence); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
175 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
176 val = make_number (i); |
211 | 177 } |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
178 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
|
179 XSETFASTINT (val, 0); |
211 | 180 else |
181 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
182 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 183 goto retry; |
184 } | |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
185 return val; |
211 | 186 } |
187 | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
188 /* This does not check for quits. That is safe |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
189 since it must terminate. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
190 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
191 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
|
192 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
|
193 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
|
194 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
|
195 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
|
196 (list) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
197 Lisp_Object list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
198 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
199 Lisp_Object tail, halftail, length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
200 int len = 0; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
201 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
202 /* halftail is used to detect circular lists. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
203 halftail = list; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
204 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
205 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
206 if (EQ (tail, halftail) && len != 0) |
12618
60c4c0fee545
(Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents:
12466
diff
changeset
|
207 break; |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
208 len++; |
13344
30e17254a280
(Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents:
13277
diff
changeset
|
209 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
|
210 halftail = XCDR (halftail); |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
211 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
212 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
213 XSETINT (length, len); |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
214 return length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
215 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
216 |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
217 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
|
218 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
|
219 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
|
220 (string) |
20881
fd35cf0efd94
(Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents:
20880
diff
changeset
|
221 Lisp_Object string; |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
222 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
223 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
|
224 return make_number (SBYTES (string)); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
225 } |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
226 |
211 | 227 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
|
228 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
|
229 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
|
230 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
|
231 (s1, s2) |
211 | 232 register Lisp_Object s1, s2; |
233 { | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
234 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
235 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
|
236 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
237 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
|
238 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
239 CHECK_STRING (s2); |
211 | 240 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
241 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
|
242 || 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
|
243 || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1))) |
211 | 244 return Qnil; |
245 return Qt; | |
246 } | |
247 | |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
248 DEFUN ("compare-strings", Fcompare_strings, |
21673
8a32bf93da04
(Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents:
21671
diff
changeset
|
249 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
|
250 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
|
251 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
|
252 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
|
253 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
|
254 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
255 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
|
256 Unibyte strings are converted to multibyte for comparison. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
257 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
258 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
|
259 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
|
260 - 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
|
261 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
|
262 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
|
263 (str1, start1, end1, str2, start2, end2, ignore_case) |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
264 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
|
265 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
266 register int end1_char, end2_char; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
267 register int i1, i1_byte, i2, i2_byte; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
268 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
269 CHECK_STRING (str1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
270 CHECK_STRING (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
271 if (NILP (start1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
272 start1 = make_number (0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
273 if (NILP (start2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
274 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
|
275 CHECK_NATNUM (start1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
276 CHECK_NATNUM (start2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
277 if (! NILP (end1)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
278 CHECK_NATNUM (end1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
279 if (! NILP (end2)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
280 CHECK_NATNUM (end2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
281 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
282 i1 = XINT (start1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
283 i2 = XINT (start2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
284 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
285 i1_byte = string_char_to_byte (str1, i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
286 i2_byte = string_char_to_byte (str2, i2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
287 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
288 end1_char = SCHARS (str1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
289 if (! NILP (end1) && end1_char > XINT (end1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
290 end1_char = XINT (end1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
291 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
292 end2_char = SCHARS (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
293 if (! NILP (end2) && end2_char > XINT (end2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
294 end2_char = XINT (end2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
295 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
296 while (i1 < end1_char && i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
297 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
298 /* When we find a mismatch, we must compare the |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
299 characters, not just the bytes. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
300 int c1, c2; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
301 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
302 if (STRING_MULTIBYTE (str1)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
303 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
|
304 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
305 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
306 c1 = SREF (str1, i1++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
307 c1 = unibyte_char_to_multibyte (c1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
308 } |
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 if (STRING_MULTIBYTE (str2)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
311 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
|
312 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
313 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
314 c2 = SREF (str2, i2++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
315 c2 = unibyte_char_to_multibyte (c2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
316 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
317 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
318 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
319 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
320 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
321 if (! NILP (ignore_case)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
322 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
323 Lisp_Object tem; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
324 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
325 tem = Fupcase (make_number (c1)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
326 c1 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
327 tem = Fupcase (make_number (c2)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
328 c2 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
329 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
330 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
331 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
332 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
333 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
334 /* Note that I1 has already been incremented |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
335 past the character that we are comparing; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
336 hence we don't add or subtract 1 here. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
337 if (c1 < c2) |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
338 return make_number (- i1 + XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
339 else |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
340 return make_number (i1 - XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
341 } |
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 if (i1 < end1_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
344 return make_number (i1 - XINT (start1) + 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
345 if (i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
346 return make_number (- i1 + XINT (start1) - 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
347 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
348 return Qt; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
349 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
350 |
211 | 351 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
|
352 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
|
353 Case is significant. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
354 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
|
355 (s1, s2) |
211 | 356 register Lisp_Object s1, s2; |
357 { | |
358 register int end; | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
359 register int i1, i1_byte, i2, i2_byte; |
211 | 360 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
361 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
362 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
|
363 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
364 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
|
365 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
366 CHECK_STRING (s2); |
211 | 367 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
368 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
|
369 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
370 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
|
371 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
|
372 end = SCHARS (s2); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
373 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
374 while (i1 < end) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
375 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
376 /* 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
|
377 characters, not just the bytes. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
378 int c1, c2; |
211 | 379 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
380 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
|
381 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
|
382 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
383 if (c1 != c2) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
384 return c1 < c2 ? Qt : Qnil; |
211 | 385 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
386 return i1 < SCHARS (s2) ? Qt : Qnil; |
211 | 387 } |
388 | |
389 static Lisp_Object concat (); | |
390 | |
391 /* ARGSUSED */ | |
392 Lisp_Object | |
393 concat2 (s1, s2) | |
394 Lisp_Object s1, s2; | |
395 { | |
396 #ifdef NO_ARG_ARRAY | |
397 Lisp_Object args[2]; | |
398 args[0] = s1; | |
399 args[1] = s2; | |
400 return concat (2, args, Lisp_String, 0); | |
401 #else | |
402 return concat (2, &s1, Lisp_String, 0); | |
403 #endif /* NO_ARG_ARRAY */ | |
404 } | |
405 | |
8966
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
406 /* ARGSUSED */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
407 Lisp_Object |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
408 concat3 (s1, s2, s3) |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
409 Lisp_Object s1, s2, s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
410 { |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
411 #ifdef NO_ARG_ARRAY |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
412 Lisp_Object args[3]; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
413 args[0] = s1; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
414 args[1] = s2; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
415 args[2] = s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
416 return concat (3, args, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
417 #else |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
418 return concat (3, &s1, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
419 #endif /* NO_ARG_ARRAY */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
420 } |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
421 |
211 | 422 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
|
423 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
|
424 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
|
425 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
|
426 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
|
427 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
|
428 (nargs, args) |
211 | 429 int nargs; |
430 Lisp_Object *args; | |
431 { | |
432 return concat (nargs, args, Lisp_Cons, 1); | |
433 } | |
434 | |
435 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
|
436 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
|
437 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
|
438 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
|
439 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
|
440 (nargs, args) |
211 | 441 int nargs; |
442 Lisp_Object *args; | |
443 { | |
444 return concat (nargs, args, Lisp_String, 0); | |
445 } | |
446 | |
447 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
|
448 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
|
449 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
|
450 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
|
451 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
|
452 (nargs, args) |
211 | 453 int nargs; |
454 Lisp_Object *args; | |
455 { | |
10006
402c87cbc4fa
(Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9965
diff
changeset
|
456 return concat (nargs, args, Lisp_Vectorlike, 0); |
211 | 457 } |
458 | |
47762 | 459 /* 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
|
460 nested sub char table are not copied. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
461 static Lisp_Object |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
462 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
|
463 Lisp_Object arg; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
464 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
465 Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
466 int i; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
467 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
468 /* Copy all the contents. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
469 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
|
470 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
471 /* 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
|
472 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
|
473 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
|
474 XCHAR_TABLE (copy)->contents[i] |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
475 = 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
|
476 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
477 return copy; |
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 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
480 |
211 | 481 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, |
48320 | 482 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
|
483 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
|
484 with the original. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
485 (arg) |
211 | 486 Lisp_Object arg; |
487 { | |
485 | 488 if (NILP (arg)) return arg; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
489 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
490 if (CHAR_TABLE_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
491 { |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
492 int i; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
493 Lisp_Object copy; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
494 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
495 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
|
496 /* 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
|
497 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents, |
17291
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
498 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) |
b66473f0d0fe
(Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents:
17182
diff
changeset
|
499 * sizeof (Lisp_Object))); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
500 |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
501 /* 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
|
502 for multibyte characters. */ |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
503 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
504 i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
505 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
|
506 XCHAR_TABLE (copy)->contents[i] |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
507 = 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
|
508 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
509 return copy; |
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 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
512 if (BOOL_VECTOR_P (arg)) |
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 Lisp_Object val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
515 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
516 = ((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
|
517 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
518 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
519 val = Fmake_bool_vector (Flength (arg), Qnil); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
520 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
|
521 size_in_chars); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
522 return val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
523 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
524 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
525 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) |
211 | 526 arg = wrong_type_argument (Qsequencep, arg); |
527 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); | |
528 } | |
529 | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
530 /* 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
|
531 a string and has text properties to be copied. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
532 struct textprop_rec |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
533 { |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
534 int argnum; /* refer to ARGS (arguments of `concat') */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
535 int from; /* refer to ARGS[argnum] (argument string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
536 int to; /* refer to VAL (the target string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
537 }; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
538 |
211 | 539 static Lisp_Object |
540 concat (nargs, args, target_type, last_special) | |
541 int nargs; | |
542 Lisp_Object *args; | |
543 enum Lisp_Type target_type; | |
544 int last_special; | |
545 { | |
546 Lisp_Object val; | |
547 register Lisp_Object tail; | |
548 register Lisp_Object this; | |
549 int toindex; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
550 int toindex_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
551 register int result_len; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
552 register int result_len_byte; |
211 | 553 register int argnum; |
554 Lisp_Object last_tail; | |
555 Lisp_Object prev; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
556 int some_multibyte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
557 /* 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
|
558 while concatinating each string because the length of resulting |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
559 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
|
560 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
|
561 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
|
562 struct textprop_rec *textprops = NULL; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
563 /* Number of elments in textprops. */ |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
564 int num_textprops = 0; |
211 | 565 |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
566 tail = Qnil; |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
567 |
211 | 568 /* In append, the last arg isn't treated like the others */ |
569 if (last_special && nargs > 0) | |
570 { | |
571 nargs--; | |
572 last_tail = args[nargs]; | |
573 } | |
574 else | |
575 last_tail = Qnil; | |
576 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
577 /* Canonicalize each argument. */ |
211 | 578 for (argnum = 0; argnum < nargs; argnum++) |
579 { | |
580 this = args[argnum]; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
581 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
|
582 || COMPILEDP (this) || BOOL_VECTOR_P (this))) |
211 | 583 { |
584 args[argnum] = wrong_type_argument (Qsequencep, this); | |
585 } | |
586 } | |
587 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
588 /* 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
|
589 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
|
590 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
|
591 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
|
592 result_len_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
593 result_len = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
594 some_multibyte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
595 for (argnum = 0; argnum < nargs; argnum++) |
211 | 596 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
597 int len; |
211 | 598 this = args[argnum]; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
599 len = XFASTINT (Flength (this)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
600 if (target_type == Lisp_String) |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
601 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
602 /* 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
|
603 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
|
604 int i; |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
605 Lisp_Object ch; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
606 int this_len_byte; |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
607 |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
608 if (VECTORP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
609 for (i = 0; i < len; i++) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
610 { |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
611 ch = XVECTOR (this)->contents[i]; |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
612 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
613 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
|
614 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
|
615 result_len_byte += this_len_byte; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
616 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
|
617 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
618 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
619 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
|
620 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
|
621 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
|
622 for (; CONSP (this); this = XCDR (this)) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
623 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
624 ch = XCAR (this); |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
625 if (! INTEGERP (ch)) |
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
626 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
|
627 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
|
628 result_len_byte += this_len_byte; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
629 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
|
630 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
631 } |
20639
12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents:
20607
diff
changeset
|
632 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
633 { |
20699
907d8633c8cc
(concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents:
20667
diff
changeset
|
634 if (STRING_MULTIBYTE (this)) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
635 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
636 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
|
637 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
|
638 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
639 else |
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 += 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
|
641 SCHARS (this)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
642 } |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
643 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
644 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
645 result_len += len; |
211 | 646 } |
647 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
648 if (! some_multibyte) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
649 result_len_byte = result_len; |
211 | 650 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
651 /* Create the output object. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
652 if (target_type == Lisp_Cons) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
653 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
|
654 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
|
655 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
|
656 else if (some_multibyte) |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
657 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
|
658 else |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
659 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
|
660 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
661 /* 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
|
662 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
|
663 return last_tail; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
664 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
665 /* Copy the contents of the args into the result. */ |
211 | 666 if (CONSP (val)) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
667 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ |
211 | 668 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
669 toindex = 0, toindex_byte = 0; |
211 | 670 |
671 prev = Qnil; | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
672 if (STRINGP (val)) |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
673 textprops |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
674 = (struct textprop_rec *) alloca (sizeof (struct textprop_rec) * nargs); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
675 |
211 | 676 for (argnum = 0; argnum < nargs; argnum++) |
677 { | |
678 Lisp_Object thislen; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
679 int thisleni = 0; |
16863
591b7a95d7a5
(concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents:
16561
diff
changeset
|
680 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
|
681 register unsigned int thisindex_byte = 0; |
211 | 682 |
683 this = args[argnum]; | |
684 if (!CONSP (this)) | |
685 thislen = Flength (this), thisleni = XINT (thislen); | |
686 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
687 /* 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
|
688 if (STRINGP (this) && STRINGP (val) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
689 && 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
|
690 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
691 int thislen_byte = SBYTES (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
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 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
|
694 SBYTES (this)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
695 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
696 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
697 textprops[num_textprops].argnum = argnum; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
698 textprops[num_textprops].from = 0; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
699 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
700 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
701 toindex_byte += thislen_byte; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
702 toindex += thisleni; |
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
703 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
|
704 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
705 /* 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
|
706 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
|
707 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
708 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
709 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
710 textprops[num_textprops].argnum = argnum; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
711 textprops[num_textprops].from = 0; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
712 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
713 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
714 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
|
715 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
|
716 SCHARS (this), 0, 1); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
717 toindex += thisleni; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
718 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
719 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
720 /* Copy element by element. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
721 while (1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
722 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
723 register Lisp_Object elt; |
211 | 724 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
725 /* 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
|
726 `this' is exhausted. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
727 if (NILP (this)) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
728 if (CONSP (this)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
729 elt = XCAR (this), this = XCDR (this); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
730 else if (thisindex >= thisleni) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
731 break; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
732 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
733 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
734 int c; |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
735 if (STRING_MULTIBYTE (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
736 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
737 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
738 thisindex, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
739 thisindex_byte); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
740 XSETFASTINT (elt, c); |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
741 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
742 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
743 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
744 XSETFASTINT (elt, SREF (this, thisindex++)); |
23152
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
745 if (some_multibyte |
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
746 && (XINT (elt) >= 0240 |
23927
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
747 || (XINT (elt) >= 0200 |
74a3a9c26a03
(concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents:
23901
diff
changeset
|
748 && ! NILP (Vnonascii_translation_table))) |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
749 && XINT (elt) < 0400) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
750 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
751 c = unibyte_char_to_multibyte (XINT (elt)); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
752 XSETINT (elt, c); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
753 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
754 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
755 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
756 else if (BOOL_VECTOR_P (this)) |
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 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
759 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
|
760 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
|
761 elt = Qt; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
762 else |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
763 elt = Qnil; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
764 thisindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
765 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
766 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
767 elt = XVECTOR (this)->contents[thisindex++]; |
211 | 768 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
769 /* 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
|
770 if (toindex < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
771 { |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
772 XSETCAR (tail, elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
773 prev = tail; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
774 tail = XCDR (tail); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
775 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
776 else if (VECTORP (val)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
777 XVECTOR (val)->contents[toindex++] = elt; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
778 else |
211 | 779 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
780 CHECK_NUMBER (elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
781 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
|
782 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
783 if (some_multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
784 toindex_byte |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
785 += 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
|
786 SDATA (val) + toindex_byte); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
787 else |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
788 SSET (val, toindex_byte++, XINT (elt)); |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
789 toindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
790 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
791 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
792 /* 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
|
793 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
|
794 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
795 int c = XINT (elt); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
796 /* P exists as a variable |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
797 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
|
798 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
|
799 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
800 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
|
801 toindex++; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
802 } |
211 | 803 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
804 } |
211 | 805 } |
485 | 806 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
|
807 XSETCDR (prev, last_tail); |
211 | 808 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
809 if (num_textprops > 0) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
810 { |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
811 Lisp_Object props; |
35352
42b56dd8986e
(concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents:
35336
diff
changeset
|
812 int last_to_end = -1; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
813 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
814 for (argnum = 0; argnum < num_textprops; argnum++) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
815 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
816 this = args[textprops[argnum].argnum]; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
817 props = text_property_list (this, |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
818 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
|
819 make_number (SCHARS (this)), |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
820 Qnil); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
821 /* 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
|
822 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
|
823 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
|
824 make_composition_value_copy (props); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
825 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
|
826 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
|
827 last_to_end = textprops[argnum].to + SCHARS (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
828 } |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
829 } |
20004 | 830 return val; |
211 | 831 } |
832 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
833 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
|
834 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
|
835 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
|
836 |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
837 void |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
838 clear_string_char_byte_cache () |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
839 { |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
840 string_char_byte_cache_string = Qnil; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
841 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
842 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
843 /* 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
|
844 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
845 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
846 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
|
847 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
848 int char_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
849 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
850 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
851 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
|
852 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
|
853 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
854 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
|
855 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
|
856 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
|
857 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
|
858 return char_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
859 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
860 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
|
861 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
862 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
|
863 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
864 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
|
865 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
|
866 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
867 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
868 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
869 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
|
870 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
|
871 } |
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 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
874 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
|
875 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
876 while (best_below < char_index) |
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 int c; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
879 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
880 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
|
881 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
882 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
883 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
|
884 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
885 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
886 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
887 while (best_above > char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
888 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
889 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
|
890 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
|
891 unsigned char *p = pend - 1; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
892 int bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
893 |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
894 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
|
895 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
|
896 if (bytes == pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
897 best_above_byte -= bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
898 else if (bytes > pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
899 best_above_byte -= (pend - p); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
900 else |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
901 best_above_byte--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
902 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
903 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
904 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
905 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
906 } |
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 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
|
909 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
|
910 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
|
911 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
912 return i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
913 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
914 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
915 /* 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
|
916 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
917 int |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
918 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
|
919 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
920 int byte_index; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
921 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
922 int i, i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
923 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
|
924 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
|
925 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
926 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
|
927 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
|
928 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
|
929 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
|
930 return byte_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
931 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
932 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
|
933 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
934 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
|
935 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
936 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
|
937 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
|
938 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
939 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
940 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
941 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
|
942 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
|
943 } |
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 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
946 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
|
947 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
948 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
|
949 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
950 int c; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
951 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
952 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
|
953 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
954 i = best_below; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
955 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
|
956 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
957 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
958 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
959 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
|
960 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
961 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
|
962 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
|
963 unsigned char *p = pend - 1; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
964 int bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
965 |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
966 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
|
967 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
|
968 if (bytes == pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
969 best_above_byte -= bytes; |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
970 else if (bytes > pend - p) |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
971 best_above_byte -= (pend - p); |
9392c9b7dd07
(count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents:
25495
diff
changeset
|
972 else |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
973 best_above_byte--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
974 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
975 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
976 i = best_above; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
977 i_byte = best_above_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
978 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
979 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
980 string_char_byte_cache_bytepos = i_byte; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
981 string_char_byte_cache_charpos = i; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
982 string_char_byte_cache_string = string; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
983 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
984 return i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
985 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
986 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
987 /* Convert STRING to a multibyte string. |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
988 Single-byte characters 0240 through 0377 are converted |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
989 by adding nonascii_insert_offset to each. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
990 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
991 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
992 string_make_multibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
993 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
994 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
995 unsigned char *buf; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
996 int nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
997 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
998 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
999 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1000 if (STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1001 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1002 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1003 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
|
1004 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
|
1005 /* 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
|
1006 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
|
1007 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
|
1008 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1009 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1010 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
|
1011 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
|
1012 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1013 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1014 ret = make_multibyte_string (buf, SCHARS (string), nbytes); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1015 SAFE_FREE (nbytes); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1016 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1017 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1018 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1019 |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1020 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1021 /* Convert STRING to a multibyte string without changing each |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1022 character codes. Thus, characters 0200 trough 0237 are converted |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1023 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
|
1024 are converted eight-bit-graphic characters. */ |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1025 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1026 Lisp_Object |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1027 string_to_multibyte (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1028 Lisp_Object string; |
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 unsigned char *buf; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1031 int nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1032 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1033 USE_SAFE_ALLOCA; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1034 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1035 if (STRING_MULTIBYTE (string)) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1036 return string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1037 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1038 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
|
1039 /* 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
|
1040 any more bytes once converted. */ |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1041 if (nbytes == SBYTES (string)) |
49815
2a19e12053a4
(string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents:
49798
diff
changeset
|
1042 return make_multibyte_string (SDATA (string), nbytes, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1043 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1044 SAFE_ALLOCA (buf, unsigned char *, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1045 bcopy (SDATA (string), buf, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1046 str_to_multibyte (buf, nbytes, SBYTES (string)); |
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 ret = make_multibyte_string (buf, SCHARS (string), nbytes); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1049 SAFE_FREE (nbytes); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1050 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1051 return ret; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1052 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1053 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1054 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1055 /* 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
|
1056 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1057 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1058 string_make_unibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1059 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1060 { |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1061 int nchars; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1062 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
|
1063 Lisp_Object ret; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1064 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1065 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1066 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1067 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1068 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1069 nchars = SCHARS (string); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1070 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1071 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
|
1072 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
|
1073 1, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1074 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1075 ret = make_unibyte_string (buf, nchars); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1076 SAFE_FREE (nchars); |
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
|
1077 |
6b858fb89033
* fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents:
55481
diff
changeset
|
1078 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1079 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1080 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1081 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
|
1082 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1083 doc: /* Return the multibyte equivalent of STRING. |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1084 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
|
1085 `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
|
1086 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
|
1087 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
|
1088 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
|
1089 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
|
1090 \(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
|
1091 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
|
1092 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1093 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1094 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1095 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1096 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1097 return string_make_multibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1098 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1099 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1100 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
|
1101 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1102 doc: /* Return the unibyte equivalent of STRING. |
45650
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1103 Multibyte character codes are converted to unibyte according to |
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1104 `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
|
1105 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
|
1106 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
|
1107 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1108 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1109 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1110 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1111 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1112 return string_make_unibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1113 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1114 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1115 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
|
1116 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1117 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
|
1118 If STRING is unibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1119 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
|
1120 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
|
1121 `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
|
1122 corresponding single byte. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1123 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1124 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
|
1125 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1126 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1127 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1128 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
|
1129 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1130 int bytes = SBYTES (string); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1131 unsigned char *str = (unsigned char *) xmalloc (bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1132 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1133 bcopy (SDATA (string), str, bytes); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1134 bytes = str_as_unibyte (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1135 string = make_unibyte_string (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1136 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
|
1137 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1138 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1139 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1140 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1141 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
|
1142 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1143 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
|
1144 If STRING is multibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1145 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
|
1146 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
|
1147 part of a multibyte form), it is converted to the corresponding |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1148 multibyte character of charset `eight-bit-control' or `eight-bit-graphic'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1149 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1150 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
|
1151 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1152 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1153 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1154 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
|
1155 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1156 Lisp_Object new_string; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1157 int nchars, nbytes; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1158 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1159 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
|
1160 SBYTES (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1161 &nchars, &nbytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1162 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
|
1163 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
|
1164 SBYTES (string)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1165 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
|
1166 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
|
1167 SBYTES (string), NULL); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1168 string = new_string; |
46379
18cf1d2514d9
* fns.c (Fstring_as_multibyte): Use STRING_SET_INTERVALS.
Ken Raeburn <raeburn@raeburn.org>
parents:
46374
diff
changeset
|
1169 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
|
1170 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1171 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1172 } |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1173 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1174 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
|
1175 1, 1, 0, |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1176 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
|
1177 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
|
1178 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
|
1179 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
|
1180 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
|
1181 are converted to eight-bit-graphic characters of the same character |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1182 codes. */) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1183 (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1184 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1185 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1186 CHECK_STRING (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1187 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1188 return string_to_multibyte (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1189 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1190 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1191 |
211 | 1192 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
|
1193 doc: /* Return a copy of ALIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1194 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
|
1195 but does not share the alist structure with ALIST. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1196 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
|
1197 are shared, however. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1198 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
|
1199 (alist) |
211 | 1200 Lisp_Object alist; |
1201 { | |
1202 register Lisp_Object tem; | |
1203 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1204 CHECK_LIST (alist); |
485 | 1205 if (NILP (alist)) |
211 | 1206 return alist; |
1207 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
|
1208 for (tem = alist; CONSP (tem); tem = XCDR (tem)) |
211 | 1209 { |
1210 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
|
1211 car = XCAR (tem); |
211 | 1212 |
1213 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
|
1214 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); |
211 | 1215 } |
1216 return alist; | |
1217 } | |
1218 | |
1219 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, | |
41006 | 1220 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
|
1221 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
|
1222 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
|
1223 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1224 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
|
1225 (string, from, to) |
211 | 1226 Lisp_Object string; |
1227 register Lisp_Object from, to; | |
1228 { | |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1229 Lisp_Object res; |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1230 int size; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1231 int size_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1232 int from_char, to_char; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1233 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
|
1234 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1235 if (! (STRINGP (string) || VECTORP (string))) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1236 wrong_type_argument (Qarrayp, string); |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1237 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1238 CHECK_NUMBER (from); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1239 |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1240 if (STRINGP (string)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1241 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1242 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
|
1243 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1244 } |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1245 else |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1246 size = XVECTOR (string)->size; |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1247 |
485 | 1248 if (NILP (to)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1249 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1250 to_char = size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1251 to_byte = size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1252 } |
211 | 1253 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1254 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1255 CHECK_NUMBER (to); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1256 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1257 to_char = XINT (to); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1258 if (to_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1259 to_char += size; |
211 | 1260 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1261 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1262 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
|
1263 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1264 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1265 from_char = XINT (from); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1266 if (from_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1267 from_char += size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1268 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1269 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
|
1270 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1271 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
|
1272 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
|
1273 make_number (to_char)); |
211 | 1274 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1275 if (STRINGP (string)) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1276 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1277 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
|
1278 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
|
1279 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1280 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
|
1281 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
|
1282 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1283 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1284 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
|
1285 XVECTOR (string)->contents + 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 return res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1288 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1289 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1290 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1291 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
|
1292 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
|
1293 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
|
1294 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
|
1295 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
|
1296 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
|
1297 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1298 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
|
1299 (string, from, to) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1300 Lisp_Object string; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1301 register Lisp_Object from, to; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1302 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1303 int size, size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1304 int from_char, to_char; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1305 int from_byte, to_byte; |
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 CHECK_STRING (string); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1308 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1309 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
|
1310 size_byte = SBYTES (string); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1311 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1312 if (NILP (from)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1313 from_char = from_byte = 0; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1314 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1315 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1316 CHECK_NUMBER (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1317 from_char = XINT (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1318 if (from_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1319 from_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1320 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1321 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
|
1322 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1323 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1324 if (NILP (to)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1325 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1326 to_char = size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1327 to_byte = size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1328 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1329 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1330 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1331 CHECK_NUMBER (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1332 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1333 to_char = XINT (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1334 if (to_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1335 to_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 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
|
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 (!(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
|
1341 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
|
1342 make_number (to_char)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1343 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1344 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
|
1345 to_char - from_char, to_byte - from_byte, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1346 STRING_MULTIBYTE (string)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1347 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1348 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1349 /* 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
|
1350 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
|
1351 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1352 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1353 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
|
1354 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1355 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
|
1356 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1357 Lisp_Object res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1358 int size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1359 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1360 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1361 if (! (STRINGP (string) || VECTORP (string))) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1362 wrong_type_argument (Qarrayp, string); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1363 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1364 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1365 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1366 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
|
1367 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1368 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1369 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1370 size = XVECTOR (string)->size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1371 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1372 if (!(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
|
1373 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
|
1374 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1375 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1376 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1377 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
|
1378 to - from, to_byte - from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1379 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1380 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
|
1381 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
|
1382 } |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1383 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1384 res = Fvector (to - from, |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1385 XVECTOR (string)->contents + from); |
20004 | 1386 |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1387 return res; |
211 | 1388 } |
1389 | |
1390 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
|
1391 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
|
1392 (n, list) |
211 | 1393 Lisp_Object n; |
1394 register Lisp_Object list; | |
1395 { | |
1396 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
|
1397 CHECK_NUMBER (n); |
211 | 1398 num = XINT (n); |
485 | 1399 for (i = 0; i < num && !NILP (list); i++) |
211 | 1400 { |
1401 QUIT; | |
26596 | 1402 if (! CONSP (list)) |
1403 wrong_type_argument (Qlistp, list); | |
1404 list = XCDR (list); | |
211 | 1405 } |
1406 return list; | |
1407 } | |
1408 | |
1409 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
|
1410 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
|
1411 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
|
1412 (n, list) |
211 | 1413 Lisp_Object n, list; |
1414 { | |
1415 return Fcar (Fnthcdr (n, list)); | |
1416 } | |
1417 | |
1418 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
|
1419 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
|
1420 (sequence, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1421 register Lisp_Object sequence, n; |
211 | 1422 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1423 CHECK_NUMBER (n); |
211 | 1424 while (1) |
1425 { | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1426 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
|
1427 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
|
1428 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
|
1429 || 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
|
1430 return Faref (sequence, n); |
211 | 1431 else |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1432 sequence = wrong_type_argument (Qsequencep, sequence); |
211 | 1433 } |
1434 } | |
1435 | |
1436 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
|
1437 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
|
1438 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
|
1439 (elt, list) |
211 | 1440 register Lisp_Object elt; |
1441 Lisp_Object list; | |
1442 { | |
1443 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
|
1444 for (tail = list; !NILP (tail); tail = XCDR (tail)) |
211 | 1445 { |
1446 register Lisp_Object tem; | |
26596 | 1447 if (! CONSP (tail)) |
1448 wrong_type_argument (Qlistp, list); | |
1449 tem = XCAR (tail); | |
485 | 1450 if (! NILP (Fequal (elt, tem))) |
211 | 1451 return tail; |
1452 QUIT; | |
1453 } | |
1454 return Qnil; | |
1455 } | |
1456 | |
1457 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
|
1458 doc: /* Return non-nil if ELT is an element of LIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1459 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
|
1460 whose car is ELT. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1461 (elt, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1462 Lisp_Object elt, list; |
211 | 1463 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1464 while (1) |
211 | 1465 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1466 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1467 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1468 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1469 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1470 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1471 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1472 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1473 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1474 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1475 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1476 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1477 list = XCDR (list); |
211 | 1478 QUIT; |
1479 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1480 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1481 if (!CONSP (list) && !NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1482 list = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1483 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1484 return list; |
211 | 1485 } |
1486 | |
1487 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
|
1488 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
|
1489 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
|
1490 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
|
1491 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1492 Lisp_Object key, list; |
211 | 1493 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1494 Lisp_Object result; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1495 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1496 while (1) |
211 | 1497 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1498 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1499 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1500 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1501 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1502 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1503 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1504 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1505 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1506 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1507 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1508 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1509 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1510 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1511 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1512 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1513 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1514 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1515 list = XCDR (list); |
211 | 1516 QUIT; |
1517 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1518 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1519 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1520 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1521 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1522 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1523 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1524 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1525 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1526 return result; |
211 | 1527 } |
1528 | |
1529 /* Like Fassq but never report an error and do not allow quits. | |
1530 Use only on lists known never to be circular. */ | |
1531 | |
1532 Lisp_Object | |
1533 assq_no_quit (key, list) | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1534 Lisp_Object key, list; |
211 | 1535 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1536 while (CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1537 && (!CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1538 || !EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1539 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1540 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1541 return CONSP (list) ? XCAR (list) : Qnil; |
211 | 1542 } |
1543 | |
1544 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
|
1545 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
|
1546 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
|
1547 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1548 Lisp_Object key, list; |
211 | 1549 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1550 Lisp_Object result, car; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1551 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1552 while (1) |
211 | 1553 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1554 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1555 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1556 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1557 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1558 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1559 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1560 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1561 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1562 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1563 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1564 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1565 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1566 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1567 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1568 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1569 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1570 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1571 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1572 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1573 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1574 list = XCDR (list); |
211 | 1575 QUIT; |
1576 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1577 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1578 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1579 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1580 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1581 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1582 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1583 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1584 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1585 return result; |
211 | 1586 } |
1587 | |
1588 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
|
1589 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
|
1590 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
|
1591 (key, list) |
211 | 1592 register Lisp_Object key; |
1593 Lisp_Object list; | |
1594 { | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1595 Lisp_Object result; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1596 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1597 while (1) |
211 | 1598 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1599 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1600 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1601 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1602 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1603 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1604 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1605 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1606 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1607 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1608 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1609 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1610 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1611 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1612 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1613 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1614 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1615 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1616 list = XCDR (list); |
211 | 1617 QUIT; |
1618 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1619 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1620 if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1621 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1622 else if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1623 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1624 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1625 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1626 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1627 return result; |
211 | 1628 } |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1629 |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1630 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
|
1631 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
|
1632 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
|
1633 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1634 Lisp_Object key, list; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1635 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1636 Lisp_Object result, cdr; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1637 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1638 while (1) |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1639 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1640 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1641 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1642 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1643 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1644 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1645 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1646 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1647 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1648 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1649 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1650 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1651 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1652 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1653 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1654 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1655 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1656 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1657 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1658 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1659 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1660 list = XCDR (list); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1661 QUIT; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1662 } |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1663 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1664 if (CONSP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1665 result = XCAR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1666 else if (NILP (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1667 result = Qnil; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1668 else |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1669 result = wrong_type_argument (Qlistp, list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1670 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1671 return result; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1672 } |
211 | 1673 |
1674 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
|
1675 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
|
1676 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
|
1677 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
|
1678 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
|
1679 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
|
1680 (elt, list) |
211 | 1681 register Lisp_Object elt; |
1682 Lisp_Object list; | |
1683 { | |
1684 register Lisp_Object tail, prev; | |
1685 register Lisp_Object tem; | |
1686 | |
1687 tail = list; | |
1688 prev = Qnil; | |
485 | 1689 while (!NILP (tail)) |
211 | 1690 { |
26596 | 1691 if (! CONSP (tail)) |
1692 wrong_type_argument (Qlistp, list); | |
1693 tem = XCAR (tail); | |
211 | 1694 if (EQ (elt, tem)) |
1695 { | |
485 | 1696 if (NILP (prev)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1697 list = XCDR (tail); |
211 | 1698 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1699 Fsetcdr (prev, XCDR (tail)); |
211 | 1700 } |
1701 else | |
1702 prev = tail; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1703 tail = XCDR (tail); |
211 | 1704 QUIT; |
1705 } | |
1706 return list; | |
1707 } | |
1708 | |
414 | 1709 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
|
1710 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
|
1711 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
|
1712 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
|
1713 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
|
1714 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
|
1715 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
|
1716 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
|
1717 (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
|
1718 Lisp_Object elt, seq; |
401 | 1719 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1720 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
|
1721 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
1722 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
|
1723 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1724 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
|
1725 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
|
1726 ++n; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1727 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1728 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
|
1729 { |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
1730 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
|
1731 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1732 for (i = n = 0; i < ASIZE (seq); ++i) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1733 if (NILP (Fequal (AREF (seq, i), elt))) |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1734 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
|
1735 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1736 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
|
1737 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1738 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1739 else if (STRINGP (seq)) |
401 | 1740 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1741 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
|
1742 int c; |
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 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
|
1745 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
|
1746 ++i, ibyte += cbytes) |
401 | 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 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
|
1749 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1750 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
|
1751 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
|
1752 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
|
1753 } |
401 | 1754 else |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1755 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1756 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
|
1757 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1758 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1759 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1760 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
|
1761 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1762 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1763 nbytes += cbytes; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1764 } |
401 | 1765 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1766 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1767 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
|
1768 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1769 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
|
1770 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1771 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
|
1772 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
|
1773 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
|
1774 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1775 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
|
1776 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
|
1777 ++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
|
1778 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1779 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
|
1780 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1781 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
|
1782 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
|
1783 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
|
1784 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1785 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1786 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1787 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
|
1788 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1789 } |
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 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
|
1792 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1793 unsigned char *from = SDATA (seq) + ibyte; |
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1794 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
|
1795 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
|
1796 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1797 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1798 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
|
1799 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1800 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
|
1801 *to++ = *from++; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1802 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1803 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1804 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1805 seq = tem; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1806 } |
401 | 1807 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1808 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1809 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1810 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
|
1811 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1812 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
|
1813 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1814 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
|
1815 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
|
1816 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1817 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
|
1818 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1819 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
|
1820 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
|
1821 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1822 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
|
1823 } |
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 prev = tail; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1826 QUIT; |
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 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1829 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1830 return seq; |
401 | 1831 } |
1832 | |
211 | 1833 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
|
1834 doc: /* Reverse LIST by modifying cdr pointers. |
53106 | 1835 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
|
1836 (list) |
211 | 1837 Lisp_Object list; |
1838 { | |
1839 register Lisp_Object prev, tail, next; | |
1840 | |
485 | 1841 if (NILP (list)) return list; |
211 | 1842 prev = Qnil; |
1843 tail = list; | |
485 | 1844 while (!NILP (tail)) |
211 | 1845 { |
1846 QUIT; | |
26596 | 1847 if (! CONSP (tail)) |
1848 wrong_type_argument (Qlistp, list); | |
1849 next = XCDR (tail); | |
211 | 1850 Fsetcdr (tail, prev); |
1851 prev = tail; | |
1852 tail = next; | |
1853 } | |
1854 return prev; | |
1855 } | |
1856 | |
1857 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, | |
53106 | 1858 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
|
1859 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
|
1860 (list) |
211 | 1861 Lisp_Object list; |
1862 { | |
18421 | 1863 Lisp_Object new; |
211 | 1864 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1865 for (new = Qnil; CONSP (list); list = XCDR (list)) |
49204 | 1866 { |
1867 QUIT; | |
1868 new = Fcons (XCAR (list), new); | |
1869 } | |
18421 | 1870 if (!NILP (list)) |
1871 wrong_type_argument (Qconsp, list); | |
1872 return new; | |
211 | 1873 } |
1874 | |
1875 Lisp_Object merge (); | |
1876 | |
1877 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
|
1878 doc: /* Sort LIST, stably, comparing elements using PREDICATE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1879 Returns the sorted list. LIST is modified by side effects. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1880 PREDICATE is called with two elements of LIST, and should return t |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1881 if the first element is "less" than the second. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1882 (list, predicate) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1883 Lisp_Object list, predicate; |
211 | 1884 { |
1885 Lisp_Object front, back; | |
1886 register Lisp_Object len, tem; | |
1887 struct gcpro gcpro1, gcpro2; | |
1888 register int length; | |
1889 | |
1890 front = list; | |
1891 len = Flength (list); | |
1892 length = XINT (len); | |
1893 if (length < 2) | |
1894 return list; | |
1895 | |
1896 XSETINT (len, (length / 2) - 1); | |
1897 tem = Fnthcdr (len, list); | |
1898 back = Fcdr (tem); | |
1899 Fsetcdr (tem, Qnil); | |
1900 | |
1901 GCPRO2 (front, back); | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1902 front = Fsort (front, predicate); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1903 back = Fsort (back, predicate); |
211 | 1904 UNGCPRO; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1905 return merge (front, back, predicate); |
211 | 1906 } |
1907 | |
1908 Lisp_Object | |
1909 merge (org_l1, org_l2, pred) | |
1910 Lisp_Object org_l1, org_l2; | |
1911 Lisp_Object pred; | |
1912 { | |
1913 Lisp_Object value; | |
1914 register Lisp_Object tail; | |
1915 Lisp_Object tem; | |
1916 register Lisp_Object l1, l2; | |
1917 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1918 | |
1919 l1 = org_l1; | |
1920 l2 = org_l2; | |
1921 tail = Qnil; | |
1922 value = Qnil; | |
1923 | |
1924 /* It is sufficient to protect org_l1 and org_l2. | |
1925 When l1 and l2 are updated, we copy the new values | |
1926 back into the org_ vars. */ | |
1927 GCPRO4 (org_l1, org_l2, pred, value); | |
1928 | |
1929 while (1) | |
1930 { | |
485 | 1931 if (NILP (l1)) |
211 | 1932 { |
1933 UNGCPRO; | |
485 | 1934 if (NILP (tail)) |
211 | 1935 return l2; |
1936 Fsetcdr (tail, l2); | |
1937 return value; | |
1938 } | |
485 | 1939 if (NILP (l2)) |
211 | 1940 { |
1941 UNGCPRO; | |
485 | 1942 if (NILP (tail)) |
211 | 1943 return l1; |
1944 Fsetcdr (tail, l1); | |
1945 return value; | |
1946 } | |
1947 tem = call2 (pred, Fcar (l2), Fcar (l1)); | |
485 | 1948 if (NILP (tem)) |
211 | 1949 { |
1950 tem = l1; | |
1951 l1 = Fcdr (l1); | |
1952 org_l1 = l1; | |
1953 } | |
1954 else | |
1955 { | |
1956 tem = l2; | |
1957 l2 = Fcdr (l2); | |
1958 org_l2 = l2; | |
1959 } | |
485 | 1960 if (NILP (tail)) |
211 | 1961 value = tem; |
1962 else | |
1963 Fsetcdr (tail, tem); | |
1964 tail = tem; | |
1965 } | |
1966 } | |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1967 |
211 | 1968 |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1969 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
|
1970 doc: /* Extract a value from a property list. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1971 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
|
1972 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1973 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
|
1974 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
|
1975 (plist, prop) |
14051
7f7e97f219ce
(Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents:
13862
diff
changeset
|
1976 Lisp_Object plist; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1977 Lisp_Object prop; |
211 | 1978 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1979 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1980 |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1981 for (tail = plist; |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1982 CONSP (tail) && CONSP (XCDR (tail)); |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1983 tail = XCDR (XCDR (tail))) |
211 | 1984 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1985 if (EQ (prop, XCAR (tail))) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1986 return XCAR (XCDR (tail)); |
37317
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1987 |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1988 /* 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
|
1989 (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
|
1990 if (!interrupt_input_blocked) |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1991 QUIT; |
211 | 1992 } |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1993 |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1994 if (!NILP (tail)) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1995 wrong_type_argument (Qlistp, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1996 |
211 | 1997 return Qnil; |
1998 } | |
1999 | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2000 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
|
2001 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
|
2002 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
|
2003 (symbol, propname) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2004 Lisp_Object symbol, propname; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2005 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2006 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2007 return Fplist_get (XSYMBOL (symbol)->plist, propname); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2008 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2009 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2010 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
|
2011 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
|
2012 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
|
2013 \(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
|
2014 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
|
2015 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
|
2016 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
|
2017 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
|
2018 (plist, prop, val) |
20004 | 2019 Lisp_Object plist; |
2020 register Lisp_Object prop; | |
2021 Lisp_Object val; | |
211 | 2022 { |
2023 register Lisp_Object tail, prev; | |
2024 Lisp_Object newcell; | |
2025 prev = Qnil; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2026 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
|
2027 tail = XCDR (XCDR (tail))) |
211 | 2028 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2029 if (EQ (prop, XCAR (tail))) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2030 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2031 Fsetcar (XCDR (tail), val); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2032 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2033 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2034 |
211 | 2035 prev = tail; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2036 QUIT; |
211 | 2037 } |
2038 newcell = Fcons (prop, Fcons (val, Qnil)); | |
485 | 2039 if (NILP (prev)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2040 return newcell; |
211 | 2041 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2042 Fsetcdr (XCDR (prev), newcell); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2043 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2044 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2045 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2046 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
|
2047 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
|
2048 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
|
2049 (symbol, propname, value) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2050 Lisp_Object symbol, propname, value; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2051 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2052 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2053 XSYMBOL (symbol)->plist |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2054 = 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
|
2055 return value; |
211 | 2056 } |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2057 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2058 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
|
2059 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
|
2060 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
|
2061 \(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
|
2062 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
|
2063 one of the properties on the list. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2064 (plist, prop) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2065 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2066 Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2067 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2068 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2069 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2070 for (tail = plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2071 CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2072 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2073 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2074 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2075 return XCAR (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2076 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2077 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2078 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2079 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2080 if (!NILP (tail)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2081 wrong_type_argument (Qlistp, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2082 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2083 return Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2084 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2085 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2086 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
|
2087 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
|
2088 PLIST is a property list, which is a list of the form |
44219 | 2089 \(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
|
2090 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
|
2091 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
|
2092 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
|
2093 The PLIST is modified by side effects. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2094 (plist, prop, val) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2095 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2096 register Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2097 Lisp_Object val; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2098 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2099 register Lisp_Object tail, prev; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2100 Lisp_Object newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2101 prev = Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2102 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2103 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2104 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2105 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2106 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2107 Fsetcar (XCDR (tail), val); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2108 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2109 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2110 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2111 prev = tail; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2112 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2113 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2114 newcell = Fcons (prop, Fcons (val, Qnil)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2115 if (NILP (prev)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2116 return newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2117 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2118 Fsetcdr (XCDR (prev), newcell); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2119 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2120 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2121 |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2122 DEFUN ("eql", Feql, Seql, 2, 2, 0, |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2123 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
|
2124 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
|
2125 (obj1, obj2) |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2126 Lisp_Object obj1, obj2; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2127 { |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2128 if (FLOATP (obj1)) |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2129 return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2130 else |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2131 return EQ (obj1, obj2) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2132 } |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2133 |
211 | 2134 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
|
2135 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
|
2136 They must have the same data type. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2137 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
|
2138 Vectors and strings are compared element by element. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2139 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
|
2140 (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
|
2141 Symbols must match exactly. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2142 (o1, o2) |
211 | 2143 register Lisp_Object o1, o2; |
2144 { | |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2145 return internal_equal (o1, o2, 0, 0) ? Qt : Qnil; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2146 } |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2147 |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2148 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
|
2149 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
|
2150 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
|
2151 of strings. (`equal' ignores text properties.) */) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2152 (o1, o2) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2153 register Lisp_Object o1, o2; |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2154 { |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2155 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
|
2156 } |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2157 |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2158 /* 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
|
2159 gets too deep. |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2160 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
|
2161 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2162 static int |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2163 internal_equal (o1, o2, depth, props) |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2164 register Lisp_Object o1, o2; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2165 int depth, props; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2166 { |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2167 if (depth > 200) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2168 error ("Stack overflow in equal"); |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2169 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2170 tail_recurse: |
211 | 2171 QUIT; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2172 if (EQ (o1, o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2173 return 1; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2174 if (XTYPE (o1) != XTYPE (o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2175 return 0; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2176 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2177 switch (XTYPE (o1)) |
211 | 2178 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2179 case Lisp_Float: |
53393
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2180 { |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2181 double d1, d2; |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2182 |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2183 d1 = extract_float (o1); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2184 d2 = extract_float (o2); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2185 /* 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
|
2186 though they are not =. */ |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2187 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
|
2188 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2189 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2190 case Lisp_Cons: |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2191 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
|
2192 return 0; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2193 o1 = XCDR (o1); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2194 o2 = XCDR (o2); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2195 goto tail_recurse; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2196 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2197 case Lisp_Misc: |
11240
2642924d2d21
(internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
2198 if (XMISCTYPE (o1) != XMISCTYPE (o2)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2199 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2200 if (OVERLAYP (o1)) |
211 | 2201 { |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2202 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
|
2203 depth + 1, props) |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2204 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2205 depth + 1)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2206 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2207 o1 = XOVERLAY (o1)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2208 o2 = XOVERLAY (o2)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2209 goto tail_recurse; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2210 } |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2211 if (MARKERP (o1)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2212 { |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2213 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
|
2214 && (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
|
2215 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); |
211 | 2216 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2217 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2218 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2219 case Lisp_Vectorlike: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2220 { |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2221 register int i; |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2222 EMACS_INT size = XVECTOR (o1)->size; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2223 /* 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
|
2224 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
|
2225 same size. */ |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2226 if (XVECTOR (o2)->size != size) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2227 return 0; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2228 /* Boolvectors are compared much like strings. */ |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2229 if (BOOL_VECTOR_P (o1)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2230 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2231 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2232 = ((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
|
2233 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2234 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2235 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
|
2236 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2237 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
|
2238 size_in_chars)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2239 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2240 return 1; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2241 } |
20776
219fdecc30d3
(internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents:
20712
diff
changeset
|
2242 if (WINDOW_CONFIGURATIONP (o1)) |
21021
7be2384fabdc
(internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents:
20992
diff
changeset
|
2243 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
|
2244 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2245 /* 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
|
2246 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
|
2247 if (size & PSEUDOVECTOR_FLAG) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2248 { |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2249 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2250 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2251 size &= PSEUDOVECTOR_SIZE_MASK; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2252 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2253 for (i = 0; i < size; i++) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2254 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2255 Lisp_Object v1, v2; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2256 v1 = XVECTOR (o1)->contents [i]; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2257 v2 = XVECTOR (o2)->contents [i]; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2258 if (!internal_equal (v1, v2, depth + 1, props)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2259 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2260 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2261 return 1; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2262 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2263 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2264 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2265 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
|
2266 if (SCHARS (o1) != SCHARS (o2)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2267 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
|
2268 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
|
2269 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
|
2270 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
|
2271 SBYTES (o1))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2272 return 0; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2273 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
|
2274 return 0; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2275 return 1; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2276 |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2277 case Lisp_Int: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2278 case Lisp_Symbol: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2279 case Lisp_Type_Limit: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2280 break; |
211 | 2281 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2282 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2283 return 0; |
211 | 2284 } |
2285 | |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
2286 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
|
2287 |
211 | 2288 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
|
2289 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
|
2290 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
|
2291 (array, item) |
211 | 2292 Lisp_Object array, item; |
2293 { | |
2294 register int size, index, charval; | |
2295 retry: | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2296 if (VECTORP (array)) |
211 | 2297 { |
2298 register Lisp_Object *p = XVECTOR (array)->contents; | |
2299 size = XVECTOR (array)->size; | |
2300 for (index = 0; index < size; index++) | |
2301 p[index] = item; | |
2302 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2303 else if (CHAR_TABLE_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2304 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2305 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
|
2306 size = CHAR_TABLE_ORDINARY_SLOTS; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2307 for (index = 0; index < size; index++) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2308 p[index] = item; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2309 XCHAR_TABLE (array)->defalt = Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2310 } |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2311 else if (STRINGP (array)) |
211 | 2312 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2313 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
|
2314 CHECK_NUMBER (item); |
211 | 2315 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
|
2316 size = SCHARS (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2317 if (STRING_MULTIBYTE (array)) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2318 { |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
2319 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
|
2320 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
|
2321 int size_byte = SBYTES (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2322 unsigned char *p1 = p, *endp = p + size_byte; |
23453
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2323 int i; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2324 |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2325 if (size != size_byte) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2326 while (p1 < endp) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2327 { |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2328 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2329 if (len != this_len) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2330 error ("Attempt to change byte length of a string"); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2331 p1 += this_len; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2332 } |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2333 for (i = 0; i < size_byte; i++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2334 *p++ = str[i % len]; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2335 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2336 else |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2337 for (index = 0; index < size; index++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2338 p[index] = charval; |
211 | 2339 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2340 else if (BOOL_VECTOR_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2341 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2342 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
|
2343 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2344 = ((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
|
2345 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2346 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2347 charval = (! NILP (item) ? -1 : 0); |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2348 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
|
2349 p[index] = charval; |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2350 if (index < size_in_chars) |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2351 { |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2352 /* 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
|
2353 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
|
2354 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
|
2355 p[index] = charval; |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2356 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2357 } |
211 | 2358 else |
2359 { | |
2360 array = wrong_type_argument (Qarrayp, array); | |
2361 goto retry; | |
2362 } | |
2363 return array; | |
2364 } | |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2365 |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2366 DEFUN ("clear-string", Fclear_string, Sclear_string, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2367 1, 1, 0, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2368 doc: /* Clear the contents of STRING. |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2369 This makes STRING unibyte and may change its length. */) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2370 (string) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2371 Lisp_Object string; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2372 { |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2373 int len = SBYTES (string); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2374 bzero (SDATA (string), len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2375 STRING_SET_CHARS (string, len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2376 STRING_SET_UNIBYTE (string); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2377 return Qnil; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2378 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2379 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2380 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
|
2381 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2382 doc: /* Return the 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
|
2383 (char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2384 Lisp_Object char_table; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2385 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2386 CHECK_CHAR_TABLE (char_table); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2387 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2388 return XCHAR_TABLE (char_table)->purpose; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2389 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2390 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2391 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
|
2392 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2393 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
|
2394 The value is either nil or another char-table. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2395 If CHAR-TABLE holds nil for a given character, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2396 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
|
2397 \(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
|
2398 (char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2399 Lisp_Object char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2400 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2401 CHECK_CHAR_TABLE (char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2402 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2403 return XCHAR_TABLE (char_table)->parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2404 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2405 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2406 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
|
2407 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2408 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
|
2409 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
|
2410 (char_table, parent) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2411 Lisp_Object char_table, parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2412 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2413 Lisp_Object temp; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2414 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2415 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
|
2416 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2417 if (!NILP (parent)) |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2418 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2419 CHECK_CHAR_TABLE (parent); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2420 |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2421 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
|
2422 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
|
2423 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
|
2424 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2425 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2426 XCHAR_TABLE (char_table)->parent = parent; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2427 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2428 return parent; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2429 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2430 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2431 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
|
2432 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2433 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
|
2434 (char_table, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2435 Lisp_Object char_table, n; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2436 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2437 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
|
2438 CHECK_NUMBER (n); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2439 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
|
2440 || 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
|
2441 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
|
2442 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2443 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
|
2444 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2445 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2446 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
|
2447 Sset_char_table_extra_slot, |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2448 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2449 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
|
2450 (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
|
2451 Lisp_Object char_table, n, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2452 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2453 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
|
2454 CHECK_NUMBER (n); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2455 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
|
2456 || 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
|
2457 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
|
2458 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2459 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
|
2460 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2461 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2462 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
|
2463 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2464 doc: /* Return the value in CHAR-TABLE for a range of characters RANGE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2465 RANGE should be nil (for the default value) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2466 a vector which identifies a character set or a row of a character set, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2467 a character set name, or a character code. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2468 (char_table, range) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2469 Lisp_Object char_table, range; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2470 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2471 CHECK_CHAR_TABLE (char_table); |
20004 | 2472 |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2473 if (EQ (range, Qnil)) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2474 return XCHAR_TABLE (char_table)->defalt; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2475 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
|
2476 return Faref (char_table, range); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2477 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
|
2478 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2479 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
|
2480 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2481 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
|
2482 CHECK_VECTOR (charset_info); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2483 |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2484 return Faref (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2485 make_number (XINT (XVECTOR (charset_info)->contents[0]) |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2486 + 128)); |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2487 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2488 else if (VECTORP (range)) |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2489 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2490 if (XVECTOR (range)->size == 1) |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2491 return Faref (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2492 make_number (XINT (XVECTOR (range)->contents[0]) + 128)); |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2493 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2494 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2495 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2496 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2497 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2498 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2499 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2500 return Faref (char_table, ch); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2501 } |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2502 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2503 else |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2504 error ("Invalid RANGE argument to `char-table-range'"); |
28666 | 2505 return Qt; |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2506 } |
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
2507 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2508 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
|
2509 3, 3, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2510 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
|
2511 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
|
2512 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
|
2513 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
|
2514 (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
|
2515 Lisp_Object char_table, range, value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2516 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2517 int i; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2518 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2519 CHECK_CHAR_TABLE (char_table); |
20004 | 2520 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2521 if (EQ (range, Qt)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2522 for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2523 XCHAR_TABLE (char_table)->contents[i] = value; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2524 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
|
2525 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
|
2526 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
|
2527 { |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2528 Lisp_Object charset_info; |
53799
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2529 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
|
2530 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
2531 charset_info = Fget (range, Qcharset); |
53799
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2532 if (! VECTORP (charset_info) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2533 || ! NATNUMP (AREF (charset_info, 0)) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2534 || (charset_id = XINT (AREF (charset_info, 0)), |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2535 ! CHARSET_DEFINED_P (charset_id))) |
53821
7848629711b6
(Fset_char_table_range): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
53799
diff
changeset
|
2536 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
|
2537 |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2538 if (charset_id == CHARSET_ASCII) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2539 for (i = 0; i < 128; i++) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2540 XCHAR_TABLE (char_table)->contents[i] = value; |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2541 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
|
2542 for (i = 128; i < 160; i++) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2543 XCHAR_TABLE (char_table)->contents[i] = value; |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2544 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
|
2545 for (i = 160; i < 256; i++) |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2546 XCHAR_TABLE (char_table)->contents[i] = value; |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2547 else |
9ddd570ce8c7
(Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents:
53742
diff
changeset
|
2548 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
|
2549 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2550 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
|
2551 Faset (char_table, range, value); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2552 else if (VECTORP (range)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2553 { |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2554 if (XVECTOR (range)->size == 1) |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2555 return Faset (char_table, |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2556 make_number (XINT (XVECTOR (range)->contents[0]) + 128), |
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
2557 value); |
18035
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2558 else |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2559 { |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2560 int size = XVECTOR (range)->size; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2561 Lisp_Object *val = XVECTOR (range)->contents; |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2562 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2563 size <= 1 ? Qnil : val[1], |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2564 size <= 2 ? Qnil : val[2]); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2565 return Faset (char_table, ch, value); |
edf54f605b36
(Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents:
18000
diff
changeset
|
2566 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2567 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2568 else |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2569 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
|
2570 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2571 return value; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2572 } |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2573 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2574 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
|
2575 Sset_char_table_default, 3, 3, 0, |
51397 | 2576 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
|
2577 The generic character specifies the group of characters. |
51397 | 2578 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
|
2579 (char_table, ch, value) |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2580 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
|
2581 { |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
2582 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
|
2583 Lisp_Object temp; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2584 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2585 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
|
2586 CHECK_NUMBER (ch); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2587 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2588 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
|
2589 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
|
2590 |
c771a25f6f8c
(Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents:
22696
diff
changeset
|
2591 /* 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
|
2592 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
|
2593 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
|
2594 if (! CHARSET_VALID_P (charset)) |
22706 | 2595 invalid_character (c); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2596 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2597 if (charset == CHARSET_ASCII) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2598 return (XCHAR_TABLE (char_table)->defalt = value); |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2599 |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2600 /* 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
|
2601 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
|
2602 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
|
2603 code1 = 0; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2604 temp = XCHAR_TABLE (char_table)->contents[charset + 128]; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2605 if (!code1) |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2606 { |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2607 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
|
2608 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2609 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2610 XCHAR_TABLE (char_table)->contents[charset + 128] = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2611 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2612 } |
35479
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2613 if (SUB_CHAR_TABLE_P (temp)) |
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2614 char_table = temp; |
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2615 else |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2616 char_table = (XCHAR_TABLE (char_table)->contents[charset + 128] |
35479
cb1dfadd1a18
(Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents:
35352
diff
changeset
|
2617 = make_sub_char_table (temp)); |
17826
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2618 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
|
2619 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
|
2620 XCHAR_TABLE (temp)->defalt = value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2621 else |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2622 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
|
2623 return value; |
961399e23170
(copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents:
17819
diff
changeset
|
2624 } |
21339
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2625 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2626 /* 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
|
2627 and return it as an integer. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2628 If the element is nil, return CH itself. |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2629 (Actually we do that for any non-integer.) */ |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2630 |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2631 int |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2632 char_table_translate (table, ch) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2633 Lisp_Object table; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2634 int ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2635 { |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2636 Lisp_Object value; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2637 value = Faref (table, make_number (ch)); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2638 if (! INTEGERP (value)) |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2639 return ch; |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2640 return XINT (value); |
91933098b4ae
(char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21260
diff
changeset
|
2641 } |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2642 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2643 static void |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2644 optimize_sub_char_table (table, chars) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2645 Lisp_Object *table; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2646 int chars; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2647 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2648 Lisp_Object elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2649 int from, to; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2650 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2651 if (chars == 94) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2652 from = 33, to = 127; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2653 else |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2654 from = 32, to = 128; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2655 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2656 if (!SUB_CHAR_TABLE_P (*table)) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2657 return; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2658 elt = XCHAR_TABLE (*table)->contents[from++]; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2659 for (; from < to; from++) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2660 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
|
2661 return; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2662 *table = elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2663 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2664 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2665 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
|
2666 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
|
2667 (table) |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2668 Lisp_Object table; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2669 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2670 Lisp_Object elt; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2671 int dim; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2672 int i, j; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2673 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2674 CHECK_CHAR_TABLE (table); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2675 |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2676 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
|
2677 { |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2678 elt = XCHAR_TABLE (table)->contents[i]; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2679 if (!SUB_CHAR_TABLE_P (elt)) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2680 continue; |
33041
10bc9f620b67
(Foptimize_char_table): Fix arg for CHARSET_DIMENSION.
Kenichi Handa <handa@m17n.org>
parents:
32753
diff
changeset
|
2681 dim = CHARSET_DIMENSION (i - 128); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2682 if (dim == 2) |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2683 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
|
2684 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
|
2685 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
|
2686 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2687 return Qnil; |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2688 } |
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
2689 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2690 |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2691 /* 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
|
2692 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
|
2693 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
|
2694 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
|
2695 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
|
2696 |
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2697 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
|
2698 |
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2699 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
|
2700 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
|
2701 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
|
2702 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
|
2703 int depth; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2704 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2705 int i, to; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2706 |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2707 if (depth == 0) |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2708 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2709 /* 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
|
2710 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
|
2711 { |
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
|
2712 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
|
2713 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
|
2714 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
|
2715 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
|
2716 elt = Faref (subtable, make_number (i)); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2717 if (c_function) |
17789
120a8d934816
(map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents:
17318
diff
changeset
|
2718 (*c_function) (arg, make_number (i), elt); |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2719 else |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2720 call2 (function, make_number (i), elt); |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2721 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2722 #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
|
2723 we should report them. */ |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2724 if (NILP (current_buffer->enable_multibyte_characters)) |
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2725 return; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2726 #endif |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2727 to = CHAR_TABLE_ORDINARY_SLOTS; |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2728 } |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2729 else |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2730 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2731 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
|
2732 |
20148
988eef7dba1b
(map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents:
20004
diff
changeset
|
2733 i = 32; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2734 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
|
2735 if (CHARSET_CHARS (charset) == 94) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2736 i++, to--; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2737 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2738 |
18000
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2739 for (; i < to; i++) |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2740 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2741 Lisp_Object elt; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2742 int charset; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2743 |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2744 elt = XCHAR_TABLE (subtable)->contents[i]; |
18108
af791b0f0657
(map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents:
18035
diff
changeset
|
2745 XSETFASTINT (indices[depth], i); |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2746 charset = XFASTINT (indices[0]) - 128; |
29232
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2747 if (depth == 0 |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2748 && (!CHARSET_DEFINED_P (charset) |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2749 || charset == CHARSET_8_BIT_CONTROL |
c0d6abd0b71b
(map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents:
29010
diff
changeset
|
2750 || 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
|
2751 continue; |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2752 |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2753 if (SUB_CHAR_TABLE_P (elt)) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2754 { |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2755 if (depth >= 3) |
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2756 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
|
2757 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
|
2758 } |
13184
04170e19b3d4
(Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents:
13140
diff
changeset
|
2759 else |
17182
47bfc66eb7f1
(map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents:
17063
diff
changeset
|
2760 { |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2761 int c1, c2, c; |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2762 |
51038
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2763 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2764 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2765 c = MAKE_CHAR (charset, c1, c2); |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2766 |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2767 if (NILP (elt)) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2768 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
|
2769 if (NILP (elt)) |
51038
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2770 elt = Faref (table, make_number (c)); |
0b084ee4c1c8
(map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
51032
diff
changeset
|
2771 |
28962
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2772 if (c_function) |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2773 (*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
|
2774 else |
3f62d70df67c
(map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents:
28666
diff
changeset
|
2775 call2 (function, make_number (c), elt); |
20004 | 2776 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2777 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2778 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2779 |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2780 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
|
2781 static void |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2782 void_call2 (a, b, c) |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2783 Lisp_Object a, b, c; |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2784 { |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2785 call2 (a, b, c); |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2786 } |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2787 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2788 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
|
2789 2, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2790 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
|
2791 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
|
2792 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
|
2793 (function, char_table) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2794 Lisp_Object function, char_table; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2795 { |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
2796 /* 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
|
2797 Lisp_Object indices[3]; |
2873e0dabbc1
(map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents:
17931
diff
changeset
|
2798 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2799 CHECK_CHAR_TABLE (char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2800 |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2801 /* 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
|
2802 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
|
2803 than returning nothing. |
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
2804 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
|
2805 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
|
2806 return Qnil; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2807 } |
30488
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2808 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2809 /* 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
|
2810 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
|
2811 TABLE. */ |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2812 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2813 Lisp_Object |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2814 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
|
2815 Lisp_Object table; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2816 int c, *idx; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2817 { |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2818 int charset, c1, c2; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2819 Lisp_Object elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2820 |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2821 if (SINGLE_BYTE_CHAR_P (c)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2822 { |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2823 *idx = c; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2824 return XCHAR_TABLE (table)->contents[c]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2825 } |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2826 SPLIT_CHAR (c, charset, c1, c2); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2827 elt = XCHAR_TABLE (table)->contents[charset + 128]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2828 *idx = MAKE_CHAR (charset, 0, 0); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2829 if (!SUB_CHAR_TABLE_P (elt)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2830 return elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2831 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
|
2832 return XCHAR_TABLE (elt)->defalt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2833 elt = XCHAR_TABLE (elt)->contents[c1]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2834 *idx = MAKE_CHAR (charset, c1, 0); |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2835 if (!SUB_CHAR_TABLE_P (elt)) |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2836 return elt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2837 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
|
2838 return XCHAR_TABLE (elt)->defalt; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2839 *idx = c; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2840 return XCHAR_TABLE (elt)->contents[c2]; |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2841 } |
e26deb1d147a
(char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents:
30417
diff
changeset
|
2842 |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2843 |
211 | 2844 /* ARGSUSED */ |
2845 Lisp_Object | |
2846 nconc2 (s1, s2) | |
2847 Lisp_Object s1, s2; | |
2848 { | |
2849 #ifdef NO_ARG_ARRAY | |
2850 Lisp_Object args[2]; | |
2851 args[0] = s1; | |
2852 args[1] = s2; | |
2853 return Fnconc (2, args); | |
2854 #else | |
2855 return Fnconc (2, &s1); | |
2856 #endif /* NO_ARG_ARRAY */ | |
2857 } | |
2858 | |
2859 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
|
2860 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
|
2861 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
|
2862 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
|
2863 (nargs, args) |
211 | 2864 int nargs; |
2865 Lisp_Object *args; | |
2866 { | |
2867 register int argnum; | |
2868 register Lisp_Object tail, tem, val; | |
2869 | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2870 val = tail = Qnil; |
211 | 2871 |
2872 for (argnum = 0; argnum < nargs; argnum++) | |
2873 { | |
2874 tem = args[argnum]; | |
485 | 2875 if (NILP (tem)) continue; |
211 | 2876 |
485 | 2877 if (NILP (val)) |
211 | 2878 val = tem; |
2879 | |
2880 if (argnum + 1 == nargs) break; | |
2881 | |
2882 if (!CONSP (tem)) | |
2883 tem = wrong_type_argument (Qlistp, tem); | |
2884 | |
2885 while (CONSP (tem)) | |
2886 { | |
2887 tail = tem; | |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2888 tem = XCDR (tail); |
211 | 2889 QUIT; |
2890 } | |
2891 | |
2892 tem = args[argnum + 1]; | |
2893 Fsetcdr (tail, tem); | |
485 | 2894 if (NILP (tem)) |
211 | 2895 args[argnum + 1] = tail; |
2896 } | |
2897 | |
2898 return val; | |
2899 } | |
2900 | |
2901 /* 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
|
2902 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
|
2903 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
|
2904 LENI is the length of VALS, which should also be the length of SEQ. */ |
211 | 2905 |
2906 static void | |
2907 mapcar1 (leni, vals, fn, seq) | |
2908 int leni; | |
2909 Lisp_Object *vals; | |
2910 Lisp_Object fn, seq; | |
2911 { | |
2912 register Lisp_Object tail; | |
2913 Lisp_Object dummy; | |
2914 register int i; | |
2915 struct gcpro gcpro1, gcpro2, gcpro3; | |
2916 | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2917 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2918 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2919 /* 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
|
2920 for (i = 0; i < leni; i++) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2921 vals[i] = Qnil; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2922 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2923 GCPRO3 (dummy, fn, seq); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2924 gcpro1.var = vals; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2925 gcpro1.nvars = leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2926 } |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2927 else |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2928 GCPRO2 (fn, seq); |
211 | 2929 /* We need not explicitly protect `tail' because it is used only on lists, and |
2930 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ | |
2931 | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2932 if (VECTORP (seq)) |
211 | 2933 { |
2934 for (i = 0; i < leni; i++) | |
2935 { | |
2936 dummy = XVECTOR (seq)->contents[i]; | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2937 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2938 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2939 vals[i] = dummy; |
211 | 2940 } |
2941 } | |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2942 else if (BOOL_VECTOR_P (seq)) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2943 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2944 for (i = 0; i < leni; i++) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2945 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2946 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2947 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
|
2948 if (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2949 dummy = Qt; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2950 else |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2951 dummy = Qnil; |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2952 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2953 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2954 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2955 vals[i] = dummy; |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2956 } |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2957 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2958 else if (STRINGP (seq)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2959 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2960 int i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2961 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2962 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
|
2963 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2964 int c; |
20712
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2965 int i_before = i; |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2966 |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2967 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
|
2968 XSETFASTINT (dummy, c); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2969 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2970 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2971 vals[i_before] = dummy; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2972 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2973 } |
211 | 2974 else /* Must be a list, since Flength did not get an error */ |
2975 { | |
2976 tail = seq; | |
2977 for (i = 0; i < leni; i++) | |
2978 { | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2979 dummy = call1 (fn, Fcar (tail)); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2980 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2981 vals[i] = dummy; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2982 tail = XCDR (tail); |
211 | 2983 } |
2984 } | |
2985 | |
2986 UNGCPRO; | |
2987 } | |
2988 | |
2989 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
|
2990 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
|
2991 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
|
2992 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
|
2993 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
|
2994 (function, sequence, separator) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2995 Lisp_Object function, sequence, separator; |
211 | 2996 { |
2997 Lisp_Object len; | |
2998 register int leni; | |
2999 int nargs; | |
3000 register Lisp_Object *args; | |
3001 register int i; | |
3002 struct gcpro gcpro1; | |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3003 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3004 USE_SAFE_ALLOCA; |
211 | 3005 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3006 len = Flength (sequence); |
211 | 3007 leni = XINT (len); |
3008 nargs = leni + leni - 1; | |
3009 if (nargs < 0) return build_string (""); | |
3010 | |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
3011 SAFE_ALLOCA_LISP (args, nargs); |
211 | 3012 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3013 GCPRO1 (separator); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3014 mapcar1 (leni, args, function, sequence); |
211 | 3015 UNGCPRO; |
3016 | |
3017 for (i = leni - 1; i >= 0; i--) | |
3018 args[i + i] = args[i]; | |
20004 | 3019 |
211 | 3020 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
|
3021 args[i] = separator; |
211 | 3022 |
56206
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3023 GCPRO1 (*args); |
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3024 gcpro1.nvars = nargs; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3025 ret = Fconcat (nargs, args); |
56206
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3026 UNGCPRO; |
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3027 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
3028 SAFE_FREE_LISP (nargs); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3029 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3030 return ret; |
211 | 3031 } |
3032 | |
3033 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
|
3034 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
|
3035 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
|
3036 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
|
3037 (function, sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3038 Lisp_Object function, sequence; |
211 | 3039 { |
3040 register Lisp_Object len; | |
3041 register int leni; | |
3042 register Lisp_Object *args; | |
56206
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3043 struct gcpro gcpro1; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3044 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3045 USE_SAFE_ALLOCA; |
211 | 3046 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3047 len = Flength (sequence); |
211 | 3048 leni = XFASTINT (len); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3049 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
3050 SAFE_ALLOCA_LISP (args, leni); |
211 | 3051 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
3052 mapcar1 (leni, args, function, sequence); |
211 | 3053 |
56206
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3054 GCPRO1 (*args); |
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3055 gcpro1.nvars = leni; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3056 ret = Flist (leni, args); |
56206
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3057 UNGCPRO; |
1305e0463707
(Fmapcar, Fmapconcat): GCPRO the args array.
Kim F. Storm <storm@cua.dk>
parents:
56203
diff
changeset
|
3058 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
3059 SAFE_FREE_LISP (leni); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3060 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3061 return ret; |
211 | 3062 } |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3063 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3064 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
|
3065 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
|
3066 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
|
3067 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
|
3068 (function, sequence) |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3069 Lisp_Object function, sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3070 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3071 register int leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3072 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3073 leni = XFASTINT (Flength (sequence)); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3074 mapcar1 (leni, 0, function, sequence); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3075 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3076 return sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
3077 } |
211 | 3078 |
3079 /* Anything that calls this function must protect from GC! */ | |
3080 | |
3081 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
|
3082 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
|
3083 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
|
3084 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
|
3085 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
|
3086 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
|
3087 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
|
3088 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
|
3089 `recenter', and `quit'.\) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3090 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3091 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
|
3092 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
|
3093 (prompt) |
211 | 3094 Lisp_Object prompt; |
3095 { | |
25071 | 3096 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
|
3097 register int answer; |
211 | 3098 Lisp_Object xprompt; |
3099 Lisp_Object args[2]; | |
3100 struct gcpro gcpro1, gcpro2; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
3101 int count = SPECPDL_INDEX (); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3102 |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3103 specbind (Qcursor_in_echo_area, Qt); |
211 | 3104 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3105 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
|
3106 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3107 CHECK_STRING (prompt); |
211 | 3108 xprompt = prompt; |
3109 GCPRO2 (prompt, xprompt); | |
3110 | |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
3111 #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
|
3112 if (display_hourglass_p) |
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents:
35513
diff
changeset
|
3113 cancel_hourglass (); |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
3114 #endif |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3115 |
211 | 3116 while (1) |
3117 { | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3118 |
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
|
3119 #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
|
3120 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
|
3121 && 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
|
3122 && 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
|
3123 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3124 Lisp_Object pane, menu; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
3125 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
|
3126 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
|
3127 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
|
3128 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
|
3129 menu = Fcons (prompt, pane); |
6303
1571be153f56
(Fyes_or_no_p): Call Fx_popup_dialog instead of Fx_popup_menu.
Fred Pierresteguy <F.Pierresteguy@frcl.bull.fr>
parents:
6057
diff
changeset
|
3130 obj = Fx_popup_dialog (Qt, menu); |
6057
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3131 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
|
3132 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
|
3133 } |
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
|
3134 #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
|
3135 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
|
3136 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
|
3137 |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3138 { |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3139 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
|
3140 |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3141 /* 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
|
3142 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
|
3143 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
|
3144 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
|
3145 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
|
3146 args[1] = xprompt; |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3147 Fmessage (2, args); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
3148 } |
211 | 3149 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3150 if (minibuffer_auto_raise) |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3151 { |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3152 Lisp_Object mini_frame; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3153 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3154 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3155 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3156 Fraise_frame (mini_frame); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3157 } |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
3158 |
23057
2dbf1ec20bf7
(Fy_or_n_p): Don't bind input-method-function.
Richard M. Stallman <rms@gnu.org>
parents:
23051
diff
changeset
|
3159 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
|
3160 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
|
3161 /* 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
|
3162 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
|
3163 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3164 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
|
3165 def = Flookup_key (map, key, Qt); |
211 | 3166 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3167 if (EQ (def, intern ("skip"))) |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3168 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3169 answer = 0; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3170 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3171 } |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3172 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
|
3173 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3174 answer = 1; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3175 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3176 } |
2311
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3177 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
|
3178 { |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3179 Frecenter (Qnil); |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3180 xprompt = prompt; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3181 continue; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
3182 } |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3183 else if (EQ (def, intern ("quit"))) |
211 | 3184 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
|
3185 /* 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
|
3186 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
|
3187 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
|
3188 Vquit_flag = Qt; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3189 |
211 | 3190 QUIT; |
1194 | 3191 |
3192 /* If we don't clear this, then the next call to read_char will | |
3193 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
|
3194 Vquit_flag = Qnil; |
211 | 3195 |
3196 Fding (Qnil); | |
3197 Fdiscard_input (); | |
3198 if (EQ (xprompt, prompt)) | |
3199 { | |
3200 args[0] = build_string ("Please answer y or n. "); | |
3201 args[1] = prompt; | |
3202 xprompt = Fconcat (2, args); | |
3203 } | |
3204 } | |
3205 UNGCPRO; | |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
3206 |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3207 if (! noninteractive) |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3208 { |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
3209 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
|
3210 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
|
3211 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
|
3212 } |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
3213 |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
3214 unbind_to (count, Qnil); |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
3215 return answer ? Qt : Qnil; |
211 | 3216 } |
3217 | |
3218 /* This is how C code calls `yes-or-no-p' and allows the user | |
3219 to redefined it. | |
3220 | |
3221 Anything that calls this function must protect from GC! */ | |
3222 | |
3223 Lisp_Object | |
3224 do_yes_or_no_p (prompt) | |
3225 Lisp_Object prompt; | |
3226 { | |
3227 return call1 (intern ("yes-or-no-p"), prompt); | |
3228 } | |
3229 | |
3230 /* Anything that calls this function must protect from GC! */ | |
3231 | |
3232 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
|
3233 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
|
3234 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
|
3235 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
|
3236 The user must confirm the answer with RET, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3237 and can edit it until it has been confirmed. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3238 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3239 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
|
3240 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
|
3241 (prompt) |
211 | 3242 Lisp_Object prompt; |
3243 { | |
3244 register Lisp_Object ans; | |
3245 Lisp_Object args[2]; | |
3246 struct gcpro gcpro1; | |
3247 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3248 CHECK_STRING (prompt); |
211 | 3249 |
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
|
3250 #ifdef HAVE_MENUS |
20004 | 3251 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
|
3252 && 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
|
3253 && 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
|
3254 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3255 Lisp_Object pane, menu, obj; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
3256 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
|
3257 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
|
3258 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
|
3259 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
|
3260 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
|
3261 menu = Fcons (prompt, pane); |
6344 | 3262 obj = Fx_popup_dialog (Qt, menu); |
6057
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
3263 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
|
3264 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
|
3265 } |
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
|
3266 #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
|
3267 |
211 | 3268 args[0] = prompt; |
3269 args[1] = build_string ("(yes or no) "); | |
3270 prompt = Fconcat (2, args); | |
3271 | |
3272 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
|
3273 |
211 | 3274 while (1) |
3275 { | |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
3276 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
|
3277 Qyes_or_no_p_history, Qnil, |
6d3cc8864678
(Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents:
19383
diff
changeset
|
3278 Qnil)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3279 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes")) |
211 | 3280 { |
3281 UNGCPRO; | |
3282 return Qt; | |
3283 } | |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3284 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no")) |
211 | 3285 { |
3286 UNGCPRO; | |
3287 return Qnil; | |
3288 } | |
3289 | |
3290 Fding (Qnil); | |
3291 Fdiscard_input (); | |
3292 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
|
3293 Fsleep_for (make_number (2), Qnil); |
211 | 3294 } |
3295 } | |
3296 | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3297 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
|
3298 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
|
3299 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3300 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
|
3301 to integer. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3302 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3303 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
|
3304 These floats are not multiplied by 100. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3305 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3306 If the 5-minute or 15-minute load averages are not available, return a |
51397 | 3307 shortened list, containing only those averages which are available. |
3308 | |
3309 An error is thrown if the load average can't be obtained. In some | |
3310 cases making it work would require Emacs being installed setuid or | |
3311 setgid so that it can read kernel information, and that usually isn't | |
3312 advisable. */) | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3313 (use_floats) |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3314 Lisp_Object use_floats; |
211 | 3315 { |
727 | 3316 double load_ave[3]; |
3317 int loads = getloadavg (load_ave, 3); | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3318 Lisp_Object ret = Qnil; |
211 | 3319 |
727 | 3320 if (loads < 0) |
3321 error ("load-average not implemented for this operating system"); | |
211 | 3322 |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3323 while (loads-- > 0) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3324 { |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3325 Lisp_Object load = (NILP (use_floats) ? |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3326 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
|
3327 : make_float (load_ave[loads])); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3328 ret = Fcons (load, ret); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
3329 } |
211 | 3330 |
727 | 3331 return ret; |
211 | 3332 } |
3333 | |
39968
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
3334 Lisp_Object Vfeatures, Qsubfeatures; |
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
3335 extern Lisp_Object Vafter_load_alist; |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3336 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3337 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
|
3338 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
|
3339 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3340 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
|
3341 presence or absence of emacs or environment extensions. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3342 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
|
3343 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
|
3344 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
|
3345 (feature, subfeature) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3346 Lisp_Object feature, subfeature; |
211 | 3347 { |
3348 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
|
3349 CHECK_SYMBOL (feature); |
211 | 3350 tem = Fmemq (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3351 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
|
3352 tem = Fmember (subfeature, Fget (feature, Qsubfeatures)); |
485 | 3353 return (NILP (tem)) ? Qnil : Qt; |
211 | 3354 } |
3355 | |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3356 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
|
3357 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
|
3358 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
|
3359 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
|
3360 (feature, subfeatures) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3361 Lisp_Object feature, subfeatures; |
211 | 3362 { |
3363 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
|
3364 CHECK_SYMBOL (feature); |
44066
d0bef01f3cb3
(Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents:
41006
diff
changeset
|
3365 CHECK_LIST (subfeatures); |
485 | 3366 if (!NILP (Vautoload_queue)) |
211 | 3367 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); |
3368 tem = Fmemq (feature, Vfeatures); | |
485 | 3369 if (NILP (tem)) |
211 | 3370 Vfeatures = Fcons (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3371 if (!NILP (subfeatures)) |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3372 Fput (feature, Qsubfeatures, subfeatures); |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
3373 LOADHIST_ATTACH (Fcons (Qprovide, feature)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3374 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3375 /* Run any load-hooks for this file. */ |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3376 tem = Fassq (feature, Vafter_load_alist); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
3377 if (CONSP (tem)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
3378 Fprogn (XCDR (tem)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
3379 |
211 | 3380 return feature; |
3381 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3382 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3383 /* `require' and its subroutines. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3384 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3385 /* 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
|
3386 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3387 Lisp_Object require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3388 |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
3389 Lisp_Object |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3390 require_unwind (old_value) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3391 Lisp_Object old_value; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3392 { |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
3393 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
|
3394 } |
211 | 3395 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3396 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
|
3397 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
|
3398 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
|
3399 is not loaded; so load the file FILENAME. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3400 If FILENAME is omitted, the printname of FEATURE is used as the file name, |
52766 | 3401 and `load' will try to load this name appended with the suffix `.elc' or |
3402 `.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
|
3403 If the optional third argument NOERROR is non-nil, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3404 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
|
3405 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
|
3406 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
|
3407 (feature, filename, noerror) |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
3408 Lisp_Object feature, filename, noerror; |
211 | 3409 { |
3410 register Lisp_Object tem; | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3411 struct gcpro gcpro1, gcpro2; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3412 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3413 CHECK_SYMBOL (feature); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3414 |
211 | 3415 tem = Fmemq (feature, Vfeatures); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3416 |
485 | 3417 if (NILP (tem)) |
211 | 3418 { |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
3419 int count = SPECPDL_INDEX (); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3420 int nesting = 0; |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3421 |
48596
65f924c09e6d
(Frequire): Don't call LOADHIST_ATTACH if feature was
Dave Love <fx@gnu.org>
parents:
48567
diff
changeset
|
3422 LOADHIST_ATTACH (Fcons (Qrequire, feature)); |
65f924c09e6d
(Frequire): Don't call LOADHIST_ATTACH if feature was
Dave Love <fx@gnu.org>
parents:
48567
diff
changeset
|
3423 |
45039 | 3424 /* This is to make sure that loadup.el gives a clear picture |
3425 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
|
3426 if (! NILP (Vpurify_flag)) |
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
3427 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
|
3428 SDATA (SYMBOL_NAME (feature))); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
3429 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3430 /* 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
|
3431 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
|
3432 signal an error. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3433 tem = require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3434 while (! NILP (tem)) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3435 { |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3436 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
|
3437 nesting++; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3438 tem = XCDR (tem); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3439 } |
48567
ecf43ac20827
fns.c (Frequire): Change nesting allowance from 2 to 3 to cause more
Steven Tamm <steventamm@mac.com>
parents:
48337
diff
changeset
|
3440 if (nesting > 3) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3441 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
|
3442 SDATA (SYMBOL_NAME (feature))); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3443 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3444 /* 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
|
3445 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
|
3446 require_nesting_list = Fcons (feature, require_nesting_list); |
211 | 3447 |
3448 /* Value saved here is to be restored into Vautoload_queue */ | |
3449 record_unwind_protect (un_autoload, Vautoload_queue); | |
3450 Vautoload_queue = Qt; | |
3451 | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3452 /* Load the file. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3453 GCPRO2 (feature, filename); |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
3454 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
|
3455 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
|
3456 UNGCPRO; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3457 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3458 /* If load failed entirely, return nil. */ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
3459 if (NILP (tem)) |
24016
43344f47a865
(Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents:
23927
diff
changeset
|
3460 return unbind_to (count, Qnil); |
211 | 3461 |
3462 tem = Fmemq (feature, Vfeatures); | |
485 | 3463 if (NILP (tem)) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3464 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
|
3465 SDATA (SYMBOL_NAME (feature))); |
211 | 3466 |
3467 /* Once loading finishes, don't undo it. */ | |
3468 Vautoload_queue = Qt; | |
3469 feature = unbind_to (count, feature); | |
3470 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3471 |
211 | 3472 return feature; |
3473 } | |
3474 | |
20004 | 3475 /* Primitives for work of the "widget" library. |
3476 In an ideal world, this section would not have been necessary. | |
3477 However, lisp function calls being as slow as they are, it turns | |
3478 out that some functions in the widget library (wid-edit.el) are the | |
3479 bottleneck of Widget operation. Here is their translation to C, | |
3480 for the sole reason of efficiency. */ | |
3481 | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3482 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
|
3483 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
|
3484 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
|
3485 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3486 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
|
3487 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
|
3488 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
|
3489 (plist, prop) |
20004 | 3490 Lisp_Object plist, prop; |
3491 { | |
3492 while (CONSP (plist) && !EQ (XCAR (plist), prop)) | |
3493 { | |
3494 QUIT; | |
3495 plist = XCDR (plist); | |
3496 plist = CDR (plist); | |
3497 } | |
3498 return plist; | |
3499 } | |
3500 | |
3501 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
|
3502 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
|
3503 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
|
3504 (widget, property, value) |
20004 | 3505 Lisp_Object widget, property, value; |
3506 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3507 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
|
3508 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
|
3509 return value; |
20004 | 3510 } |
3511 | |
3512 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
|
3513 doc: /* In WIDGET, get the value of PROPERTY. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3514 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
|
3515 later with `widget-put'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3516 (widget, property) |
20004 | 3517 Lisp_Object widget, property; |
3518 { | |
3519 Lisp_Object tmp; | |
3520 | |
3521 while (1) | |
3522 { | |
3523 if (NILP (widget)) | |
3524 return Qnil; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3525 CHECK_CONS (widget); |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3526 tmp = Fplist_member (XCDR (widget), property); |
20004 | 3527 if (CONSP (tmp)) |
3528 { | |
3529 tmp = XCDR (tmp); | |
3530 return CAR (tmp); | |
3531 } | |
3532 tmp = XCAR (widget); | |
3533 if (NILP (tmp)) | |
3534 return Qnil; | |
3535 widget = Fget (tmp, Qwidget_type); | |
3536 } | |
3537 } | |
3538 | |
3539 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
|
3540 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
|
3541 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
|
3542 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
|
3543 (nargs, args) |
20004 | 3544 int nargs; |
3545 Lisp_Object *args; | |
3546 { | |
3547 /* This function can GC. */ | |
3548 Lisp_Object newargs[3]; | |
3549 struct gcpro gcpro1, gcpro2; | |
3550 Lisp_Object result; | |
3551 | |
3552 newargs[0] = Fwidget_get (args[0], args[1]); | |
3553 newargs[1] = args[0]; | |
3554 newargs[2] = Flist (nargs - 2, args + 2); | |
3555 GCPRO2 (newargs[0], newargs[2]); | |
3556 result = Fapply (3, newargs); | |
3557 UNGCPRO; | |
3558 return result; | |
3559 } | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3560 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3561 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3562 #include <langinfo.h> |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3563 #endif |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3564 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3565 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
|
3566 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
|
3567 ITEM should be one of the following: |
51397 | 3568 |
49798 | 3569 `codeset', returning the character set as a string (locale item CODESET); |
51397 | 3570 |
49798 | 3571 `days', returning a 7-element vector of day names (locale items DAY_n); |
51397 | 3572 |
49798 | 3573 `months', returning a 12-element vector of month names (locale items MON_n); |
51397 | 3574 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3575 `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
|
3576 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
|
3577 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3578 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
|
3579 `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
|
3580 |
49798 | 3581 See also Info node `(libc)Locales'. |
3582 | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3583 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
|
3584 (item) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3585 Lisp_Object item; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3586 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3587 char *str = NULL; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3588 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3589 Lisp_Object val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3590 if (EQ (item, Qcodeset)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3591 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3592 str = nl_langinfo (CODESET); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3593 return build_string (str); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3594 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3595 #ifdef DAY_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3596 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
|
3597 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3598 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
|
3599 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
|
3600 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3601 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3602 for (i = 0; i < 7; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3603 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3604 str = nl_langinfo (days[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3605 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
|
3606 /* 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
|
3607 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
|
3608 Faset (v, make_number (i), |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3609 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
|
3610 0)); |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3611 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3612 return v; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3613 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3614 #endif /* DAY_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3615 #ifdef MON_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3616 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
|
3617 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3618 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
|
3619 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
|
3620 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
|
3621 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3622 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3623 for (i = 0; i < 12; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3624 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3625 str = nl_langinfo (months[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3626 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
|
3627 p->contents[i] = |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
3628 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
|
3629 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3630 XSETVECTOR (val, p); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3631 return val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3632 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3633 #endif /* MON_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3634 /* 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
|
3635 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
|
3636 #ifdef PAPER_WIDTH |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3637 else if (EQ (item, Qpaper)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3638 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3639 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
|
3640 make_number (nl_langinfo (PAPER_HEIGHT))); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3641 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3642 #endif /* PAPER_WIDTH */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3643 #endif /* HAVE_LANGINFO_CODESET*/ |
51397 | 3644 return Qnil; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3645 } |
20004 | 3646 |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3647 /* 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
|
3648 Based on code from GNU recode. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3649 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3650 #define MIME_LINE_LENGTH 76 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3651 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3652 #define IS_ASCII(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3653 ((Character) < 128) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3654 #define IS_BASE64(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3655 (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
|
3656 #define IS_BASE64_IGNORABLE(Character) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3657 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3658 || (Character) == '\f' || (Character) == '\r') |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3659 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3660 /* 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
|
3661 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
|
3662 process. */ |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3663 #define READ_QUADRUPLET_BYTE(retval) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3664 do \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3665 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3666 if (i == length) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3667 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3668 if (nchars_return) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3669 *nchars_return = nchars; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3670 return (retval); \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3671 } \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3672 c = from[i++]; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3673 } \ |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3674 while (IS_BASE64_IGNORABLE (c)) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3675 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3676 /* 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
|
3677 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
|
3678 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3679 '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
|
3680 '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
|
3681 '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
|
3682 '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
|
3683 '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
|
3684 '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
|
3685 '8', '9', '+', '/' /* 60-63 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3686 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3687 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3688 /* 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
|
3689 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
|
3690 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3691 -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
|
3692 -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
|
3693 -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
|
3694 -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
|
3695 -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
|
3696 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
|
3697 -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
|
3698 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
|
3699 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
|
3700 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
|
3701 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
|
3702 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
|
3703 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
|
3704 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3705 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3706 /* 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
|
3707 get transformed into four base64 characters. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3708 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3709 .--------. .--------. .--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3710 |aaaaaabb| |bbbbcccc| |ccdddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3711 `--------' `--------' `--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3712 6 2 4 4 2 6 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3713 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3714 |00aaaaaa|00bbbbbb|00cccccc|00dddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3715 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3716 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3717 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3718 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3719 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3720 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3721 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
|
3722 base64 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3723 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3724 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3725 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
|
3726 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
|
3727 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3728 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
|
3729 2, 3, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3730 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
|
3731 Return the length of the encoded text. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3732 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
|
3733 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3734 (beg, end, no_line_break) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3735 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
|
3736 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3737 char *encoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3738 int allength, length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3739 int ibeg, iend, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3740 int old_pos = PT; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3741 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3742 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3743 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3744 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3745 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3746 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3747 move_gap_both (XFASTINT (beg), ibeg); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3748 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3749 /* 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
|
3750 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
|
3751 characters, and then we round up. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3752 length = iend - ibeg; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3753 allength = length + length/3 + 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3754 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
|
3755 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3756 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3757 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
|
3758 NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3759 !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
|
3760 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3761 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3762 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3763 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3764 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3765 /* The encoding wasn't possible. */ |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3766 SAFE_FREE (allength); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3767 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
|
3768 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3769 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3770 /* 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
|
3771 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
|
3772 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
|
3773 insert (encoded, encoded_length); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3774 SAFE_FREE (allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3775 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
|
3776 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3777 /* 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
|
3778 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
|
3779 if (old_pos >= XFASTINT (end)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3780 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
|
3781 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
|
3782 old_pos = XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3783 SET_PT (old_pos); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3784 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3785 /* 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
|
3786 return make_number (encoded_length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3787 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3788 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3789 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
|
3790 1, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3791 doc: /* Base64-encode STRING and return the result. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3792 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
|
3793 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3794 (string, no_line_break) |
24377
f881dd22ec7d
(Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents:
24334
diff
changeset
|
3795 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
|
3796 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3797 int allength, length, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3798 char *encoded; |
23690 | 3799 Lisp_Object encoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3800 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3801 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3802 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3803 |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3804 /* 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
|
3805 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
|
3806 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
|
3807 length = SBYTES (string); |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3808 allength = length + length/3 + 1; |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3809 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
|
3810 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3811 /* 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
|
3812 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3813 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3814 encoded_length = base64_encode_1 (SDATA (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3815 encoded, length, NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3816 STRING_MULTIBYTE (string)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3817 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3818 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3819 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3820 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3821 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3822 /* The encoding wasn't possible. */ |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3823 SAFE_FREE (allength); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3824 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
|
3825 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3826 |
23690 | 3827 encoded_string = make_unibyte_string (encoded, encoded_length); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3828 SAFE_FREE (allength); |
23690 | 3829 |
3830 return encoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3831 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3832 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3833 static int |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3834 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
|
3835 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3836 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3837 int length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3838 int line_break; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3839 int multibyte; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3840 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3841 int counter = 0, i = 0; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3842 char *e = to; |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3843 int c; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3844 unsigned int value; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3845 int bytes; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3846 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3847 while (i < length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3848 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3849 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3850 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3851 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
|
3852 if (c >= 256) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3853 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3854 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3855 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3856 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3857 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3858 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3859 /* Wrap line every 76 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3860 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3861 if (line_break) |
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 if (counter < MIME_LINE_LENGTH / 4) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3864 counter++; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3865 else |
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 *e++ = '\n'; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3868 counter = 1; |
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 } |
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 /* Process first byte of a triplet. */ |
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 *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
|
3875 value = (0x03 & c) << 4; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3876 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3877 /* Process second byte of a triplet. */ |
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 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3880 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3881 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3882 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3883 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3884 break; |
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 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3887 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3888 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3889 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
|
3890 if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3891 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3892 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3893 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3894 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3895 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3896 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3897 *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
|
3898 value = (0x0f & c) << 2; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3899 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3900 /* Process third byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3901 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3902 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3903 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3904 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3905 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3906 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3907 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3908 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3909 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3910 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3911 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
|
3912 if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3913 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3914 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3915 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3916 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3917 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3918 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3919 *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
|
3920 *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
|
3921 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3922 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3923 return e - to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3924 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3925 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3926 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3927 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
|
3928 2, 2, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3929 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
|
3930 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
|
3931 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
|
3932 (beg, end) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3933 Lisp_Object beg, end; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3934 { |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3935 int ibeg, iend, length, allength; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3936 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3937 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3938 int decoded_length; |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3939 int inserted_chars; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3940 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
|
3941 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3942 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3943 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3944 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3945 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3946 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3947 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3948 length = iend - ibeg; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3949 |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3950 /* 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
|
3951 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
|
3952 most two bytes. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3953 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
|
3954 SAFE_ALLOCA (decoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3955 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3956 move_gap_both (XFASTINT (beg), ibeg); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3957 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
|
3958 multibyte, &inserted_chars); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3959 if (decoded_length > allength) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3960 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3961 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3962 if (decoded_length < 0) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3963 { |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3964 /* The decoding wasn't possible. */ |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3965 SAFE_FREE (allength); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3966 error ("Invalid base64 data"); |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3967 } |
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 /* 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
|
3970 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
|
3971 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3972 insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3973 SAFE_FREE (allength); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3974 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3975 /* Delete the original text. */ |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3976 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
|
3977 iend + decoded_length, 1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3978 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3979 /* 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
|
3980 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
|
3981 if (old_pos >= XFASTINT (end)) |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3982 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
|
3983 else if (old_pos > XFASTINT (beg)) |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3984 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
|
3985 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
|
3986 |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3987 return make_number (inserted_chars); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3988 } |
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 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
|
3991 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3992 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
|
3993 (string) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3994 Lisp_Object string; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3995 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3996 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3997 int length, decoded_length; |
23690 | 3998 Lisp_Object decoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3999 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4000 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
4001 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4002 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4003 length = SBYTES (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4004 /* 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
|
4005 SAFE_ALLOCA (decoded, char *, length); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4006 |
32753
401f661f11d4
2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
32351
diff
changeset
|
4007 /* 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
|
4008 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
|
4009 0, NULL); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4010 if (decoded_length > length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4011 abort (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
4012 else if (decoded_length >= 0) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
4013 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
|
4014 else |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
4015 decoded_string = Qnil; |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
4016 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
4017 SAFE_FREE (length); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
4018 if (!STRINGP (decoded_string)) |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
4019 error ("Invalid base64 data"); |
23690 | 4020 |
4021 return decoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4022 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4023 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4024 /* 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
|
4025 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
|
4026 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
|
4027 characters in *NCHARS_RETURN. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4028 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4029 static int |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4030 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
|
4031 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4032 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4033 int length; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4034 int multibyte; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4035 int *nchars_return; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4036 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4037 int i = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4038 char *e = to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4039 unsigned char c; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4040 unsigned long value; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4041 int nchars = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4042 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4043 while (1) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4044 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4045 /* Process first byte of a quadruplet. */ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4046 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4047 READ_QUADRUPLET_BYTE (e-to); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4048 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4049 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4050 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4051 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
|
4052 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4053 /* Process second byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4054 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4055 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4056 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4057 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4058 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4059 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
|
4060 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4061 c = (unsigned char) (value >> 16); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4062 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4063 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4064 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4065 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4066 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4067 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4068 /* 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
|
4069 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4070 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4071 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4072 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4073 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4074 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
|
4075 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4076 if (c != '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4077 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4078 continue; |
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 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4082 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4083 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
|
4084 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4085 c = (unsigned char) (0xff & value >> 8); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4086 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4087 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4088 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4089 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4090 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4091 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4092 /* Process fourth byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4093 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
4094 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4095 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4096 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4097 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4098 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4099 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4100 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4101 value |= base64_char_to_value[c]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4102 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4103 c = (unsigned char) (0xff & value); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4104 if (multibyte) |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4105 e += CHAR_STRING (c, e); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4106 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4107 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
4108 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4109 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
4110 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4111 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4112 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4113 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4114 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4115 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4116 ***** Hash Tables ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4117 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4118 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4119 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4120 /* Implemented by gerd@gnu.org. This hash table implementation was |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4121 inspired by CMUCL hash tables. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4122 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4123 /* Ideas: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4124 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4125 1. For small tables, association lists are probably faster than |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4126 hash tables because they have lower overhead. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4127 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4128 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
|
4129 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
|
4130 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
|
4131 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
|
4132 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
|
4133 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4134 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4135 /* 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
|
4136 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4137 Lisp_Object Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4138 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4139 /* Various symbols. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4140 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4141 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue; |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
4142 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
|
4143 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
|
4144 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4145 /* Function prototypes. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4146 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4147 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
|
4148 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
|
4149 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
|
4150 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
|
4151 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4152 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
|
4153 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4154 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
|
4155 unsigned, Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4156 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
|
4157 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
|
4158 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
|
4159 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4160 Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4161 static unsigned sxhash_string P_ ((unsigned char *, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4162 static unsigned sxhash_list P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4163 static unsigned sxhash_vector P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4164 static unsigned sxhash_bool_vector P_ ((Lisp_Object)); |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4165 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
|
4166 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4167 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4168 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4169 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4170 Utilities |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4171 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4172 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4173 /* 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
|
4174 Lisp_Hash_Table. Otherwise, signal an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4175 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4176 static struct Lisp_Hash_Table * |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4177 check_hash_table (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4178 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4179 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
4180 CHECK_HASH_TABLE (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4181 return XHASH_TABLE (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4182 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4183 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4184 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4185 /* 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
|
4186 number. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4187 |
29979
6fe8f444b6a3
(next_almost_prime): Make it externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
29953
diff
changeset
|
4188 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4189 next_almost_prime (n) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4190 int n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4191 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4192 if (n % 2 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4193 n += 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4194 if (n % 3 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4195 n += 2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4196 if (n % 7 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4197 n += 4; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4198 return n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4199 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4200 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4201 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4202 /* 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
|
4203 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
|
4204 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
|
4205 -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
|
4206 a DEFUN parameter list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4207 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4208 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4209 get_key_arg (key, nargs, args, used) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4210 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4211 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4212 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4213 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4214 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4215 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
|
4216 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4217 for (i = 0; i < nargs - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4218 if (!used[i] && EQ (args[i], key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4219 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4220 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4221 if (i >= nargs - 1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4222 i = -1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4223 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4224 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4225 used[i++] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4226 used[i] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4227 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4228 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4229 return i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4230 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4231 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4232 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4233 /* 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
|
4234 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
|
4235 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
|
4236 |
28481
3caab3235bc1
(larger_vector): Make externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
28222
diff
changeset
|
4237 Lisp_Object |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4238 larger_vector (vec, new_size, init) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4239 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4240 int new_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4241 Lisp_Object init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4242 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4243 struct Lisp_Vector *v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4244 int i, old_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4245 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4246 xassert (VECTORP (vec)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4247 old_size = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4248 xassert (new_size >= old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4249 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4250 v = allocate_vector (new_size); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4251 bcopy (XVECTOR (vec)->contents, v->contents, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4252 old_size * sizeof *v->contents); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4253 for (i = old_size; i < new_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4254 v->contents[i] = init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4255 XSETVECTOR (vec, v); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4256 return vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4257 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4258 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4259 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4260 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4261 Low-level Functions |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4262 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4263 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4264 /* 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
|
4265 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
|
4266 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4267 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4268 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4269 cmpfn_eql (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4270 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4271 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4272 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4273 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4274 return (FLOATP (key1) |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4275 && FLOATP (key2) |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4276 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)); |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4279 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4280 /* 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
|
4281 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
|
4282 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4283 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4284 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4285 cmpfn_equal (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4286 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4287 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4288 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4289 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4290 return hash1 == hash2 && !NILP (Fequal (key1, key2)); |
25005
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 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4293 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4294 /* 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
|
4295 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
|
4296 if KEY1 and KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4297 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4298 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4299 cmpfn_user_defined (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4300 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4301 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4302 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4303 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4304 if (hash1 == hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4305 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4306 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
|
4307 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4308 args[0] = h->user_cmp_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4309 args[1] = key1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4310 args[2] = key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4311 return !NILP (Ffuncall (3, args)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4312 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4313 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4314 return 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4315 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4316 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4317 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4318 /* 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
|
4319 `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
|
4320 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4321 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4322 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4323 hashfn_eq (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4324 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4325 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4326 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4327 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
|
4328 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4329 return hash; |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4332 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4333 /* 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
|
4334 `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
|
4335 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4336 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4337 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4338 hashfn_eql (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4339 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4340 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4341 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4342 unsigned hash; |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4343 if (FLOATP (key)) |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4344 hash = sxhash (key, 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4345 else |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4346 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
|
4347 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4348 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4349 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4350 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4351 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4352 /* 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
|
4353 `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
|
4354 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4355 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4356 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4357 hashfn_equal (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4358 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4359 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4360 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4361 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
|
4362 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4363 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4364 } |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4367 /* 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
|
4368 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
|
4369 guaranteed to fit in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4370 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4371 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4372 hashfn_user_defined (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4373 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4374 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4375 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4376 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
|
4377 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4378 args[0] = h->user_hash_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4379 args[1] = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4380 hash = Ffuncall (2, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4381 if (!INTEGERP (hash)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4382 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4383 list2 (build_string ("Invalid hash code returned from \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4384 user-supplied hash function"), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4385 hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4386 return XUINT (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4387 } |
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 /* Create and initialize a new hash table. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4391 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4392 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
|
4393 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
|
4394 `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
|
4395 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
|
4396 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4397 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
|
4398 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4399 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
|
4400 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
|
4401 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
|
4402 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
|
4403 REHASH_SIZE. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4404 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4405 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
|
4406 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
|
4407 (table size) is >= REHASH_THRESHOLD. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4408 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4409 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
|
4410 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
|
4411 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4412 Lisp_Object |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4413 make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4414 user_test, user_hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4415 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4416 Lisp_Object user_test, user_hash; |
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 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4419 Lisp_Object table; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4420 int index_size, i, sz; |
25005
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 /* Preconditions. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4423 xassert (SYMBOLP (test)); |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4424 xassert (INTEGERP (size) && XINT (size) >= 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4425 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4426 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4427 xassert (FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4428 && XFLOATINT (rehash_threshold) > 0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4429 && XFLOATINT (rehash_threshold) <= 1.0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4430 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4431 if (XFASTINT (size) == 0) |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4432 size = make_number (1); |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
4433 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4434 /* Allocate a table and initialize it. */ |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4435 h = allocate_hash_table (); |
25005
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 /* Initialize hash table slots. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4438 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
|
4439 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4440 h->test = test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4441 if (EQ (test, Qeql)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4442 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4443 h->cmpfn = cmpfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4444 h->hashfn = hashfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4445 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4446 else if (EQ (test, Qeq)) |
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 h->cmpfn = NULL; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4449 h->hashfn = hashfn_eq; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4450 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4451 else if (EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4452 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4453 h->cmpfn = cmpfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4454 h->hashfn = hashfn_equal; |
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 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4457 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4458 h->user_cmp_function = user_test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4459 h->user_hash_function = user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4460 h->cmpfn = cmpfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4461 h->hashfn = hashfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4462 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4463 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4464 h->weak = weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4465 h->rehash_threshold = rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4466 h->rehash_size = rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4467 h->count = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4468 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
|
4469 h->hash = Fmake_vector (size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4470 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
|
4471 /* 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
|
4472 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
|
4473 h->index = Fmake_vector (make_number (index_size), Qnil); |
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 /* Set up the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4476 for (i = 0; i < sz - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4477 HASH_NEXT (h, i) = make_number (i + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4478 h->next_free = make_number (0); |
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 XSET_HASH_TABLE (table, h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4481 xassert (HASH_TABLE_P (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4482 xassert (XHASH_TABLE (table) == h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4483 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4484 /* 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
|
4485 if (NILP (h->weak)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4486 h->next_weak = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4487 else |
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 h->next_weak = Vweak_hash_tables; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4490 Vweak_hash_tables = table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4491 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4492 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4493 return table; |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4496 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4497 /* 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
|
4498 only the table itself is. */ |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4499 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4500 Lisp_Object |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4501 copy_hash_table (h1) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4502 struct Lisp_Hash_Table *h1; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4503 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4504 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4505 struct Lisp_Hash_Table *h2; |
40769
fa1546836808
(copy_hash_table): Remove unused variable `v'.
Pavel Janík <Pavel@Janik.cz>
parents:
40734
diff
changeset
|
4506 struct Lisp_Vector *next; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4507 |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4508 h2 = allocate_hash_table (); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4509 next = h2->vec_next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4510 bcopy (h1, h2, sizeof *h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4511 h2->vec_next = next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4512 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
|
4513 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
|
4514 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
|
4515 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
|
4516 XSET_HASH_TABLE (table, h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4517 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4518 /* 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
|
4519 if (!NILP (h2->weak)) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4520 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4521 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
|
4522 Vweak_hash_tables = table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4523 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4524 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4525 return table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4526 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4527 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4528 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4529 /* 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
|
4530 because it's already too large, throw an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4531 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4532 static INLINE void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4533 maybe_resize_hash_table (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4534 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4535 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4536 if (NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4537 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4538 int old_size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4539 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
|
4540 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4541 if (INTEGERP (h->rehash_size)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4542 new_size = old_size + XFASTINT (h->rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4543 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4544 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
|
4545 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
|
4546 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
|
4547 (new_size |
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4548 / XFLOATINT (h->rehash_threshold))); |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4549 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
|
4550 error ("Hash table too large to resize"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4551 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4552 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
|
4553 h->next = larger_vector (h->next, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4554 h->hash = larger_vector (h->hash, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4555 h->index = Fmake_vector (make_number (index_size), Qnil); |
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 /* 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
|
4558 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
|
4559 maphash faster. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4560 for (i = old_size; i < new_size - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4561 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
|
4562 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4563 if (!NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4564 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4565 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
|
4566 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4567 last = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4568 while (next = HASH_NEXT (h, XFASTINT (last)), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4569 !NILP (next)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4570 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
|
4571 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4572 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4573 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4574 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4575 XSETFASTINT (h->next_free, old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4576 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4577 /* Rehash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4578 for (i = 0; i < old_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4579 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4580 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4581 unsigned hash_code = XUINT (HASH_HASH (h, i)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4582 int start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4583 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4584 HASH_INDEX (h, start_of_bucket) = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4585 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4586 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4587 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4588 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4589 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4590 /* 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
|
4591 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
|
4592 matching KEY, or -1 if not found. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4593 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4594 int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4595 hash_lookup (h, key, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4596 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4597 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4598 unsigned *hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4599 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4600 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4601 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4602 Lisp_Object idx; |
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 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4605 if (hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4606 *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
|
4607 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4608 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4609 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4610 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4611 /* 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
|
4612 while (!NILP (idx)) |
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 int i = XFASTINT (idx); |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4615 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
|
4616 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4617 && 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
|
4618 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4619 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4620 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4621 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4622 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4623 return NILP (idx) ? -1 : XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4624 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4625 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4626 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4627 /* 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
|
4628 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
|
4629 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
|
4630 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4631 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4632 hash_put (h, key, value, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4633 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4634 Lisp_Object key, value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4635 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4636 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4637 int start_of_bucket, i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4638 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4639 xassert ((hash & ~INTMASK) == 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4640 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4641 /* Increment count after resizing because resizing may fail. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4642 maybe_resize_hash_table (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4643 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
|
4644 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4645 /* Store key/value in the key_and_value vector. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4646 i = XFASTINT (h->next_free); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4647 h->next_free = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4648 HASH_KEY (h, i) = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4649 HASH_VALUE (h, i) = value; |
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 /* Remember its hash code. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4652 HASH_HASH (h, i) = make_number (hash); |
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 /* Add new entry to its collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4655 start_of_bucket = hash % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4656 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4657 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
|
4658 return i; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4659 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4660 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4661 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4662 /* 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
|
4663 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4664 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4665 hash_remove (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4666 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4667 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4668 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4669 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4670 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4671 Lisp_Object idx, prev; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4672 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4673 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4674 start_of_bucket = hash_code % XVECTOR (h->index)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4675 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4676 prev = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4677 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4678 /* 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
|
4679 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4680 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4681 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4682 |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4683 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
|
4684 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4685 && 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
|
4686 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4687 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4688 /* Take entry out of collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4689 if (NILP (prev)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4690 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4691 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4692 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); |
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 /* 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
|
4695 the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4696 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
|
4697 HASH_NEXT (h, i) = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4698 h->next_free = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4699 h->count = make_number (XFASTINT (h->count) - 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4700 xassert (XINT (h->count) >= 0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4701 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4702 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4703 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4704 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4705 prev = idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4706 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4707 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4708 } |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4711 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4712 /* Clear hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4713 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4714 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4715 hash_clear (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4716 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4717 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4718 if (XFASTINT (h->count) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4719 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4720 int i, size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4721 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4722 for (i = 0; i < size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4723 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4724 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
|
4725 HASH_KEY (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4726 HASH_VALUE (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4727 HASH_HASH (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4728 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4729 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4730 for (i = 0; i < XVECTOR (h->index)->size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4731 XVECTOR (h->index)->contents[i] = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4732 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4733 h->next_free = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4734 h->count = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4735 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4736 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4737 |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4740 /************************************************************************ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4741 Weak Hash Tables |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4742 ************************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4743 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4744 /* 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
|
4745 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
|
4746 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
|
4747 non-zero if anything was marked. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4748 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4749 static int |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4750 sweep_weak_table (h, remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4751 struct Lisp_Hash_Table *h; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4752 int remove_entries_p; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4753 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4754 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
|
4755 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4756 n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4757 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
|
4758 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4759 for (bucket = 0; bucket < n; ++bucket) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4760 { |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4761 Lisp_Object idx, next, prev; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4762 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4763 /* Follow collision chain, removing entries that |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4764 don't survive this garbage collection. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4765 prev = Qnil; |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4766 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
|
4767 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4768 int i = XFASTINT (idx); |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4769 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
|
4770 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
|
4771 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
|
4772 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4773 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
|
4774 remove_p = !key_known_to_survive_p; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4775 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
|
4776 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
|
4777 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
|
4778 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
|
4779 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
|
4780 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
|
4781 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4782 abort (); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4783 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4784 next = HASH_NEXT (h, i); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4785 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4786 if (remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4787 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4788 if (remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4789 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4790 /* Take out of collision chain. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4791 if (GC_NILP (prev)) |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4792 HASH_INDEX (h, bucket) = next; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4793 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4794 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
|
4795 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4796 /* Add to free list. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4797 HASH_NEXT (h, i) = h->next_free; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4798 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
|
4799 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4800 /* Clear key, value, and hash. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4801 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4802 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
|
4803 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4804 h->count = make_number (XFASTINT (h->count) - 1); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4805 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4806 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4807 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4808 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4809 if (!remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4810 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4811 /* 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
|
4812 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
|
4813 { |
51768
31f2f6a2df06
(sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51397
diff
changeset
|
4814 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
|
4815 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4816 } |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4817 |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4818 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
|
4819 { |
51768
31f2f6a2df06
(sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51397
diff
changeset
|
4820 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
|
4821 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4822 } |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4823 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4824 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4825 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4826 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4827 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4828 return marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4829 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4830 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4831 /* 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
|
4832 current garbage collection. Remove weak tables that don't survive |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4833 from Vweak_hash_tables. Called from gc_sweep. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4834 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4835 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4836 sweep_weak_hash_tables () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4837 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4838 Lisp_Object table, used, next; |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4839 struct Lisp_Hash_Table *h; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4840 int marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4841 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4842 /* 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
|
4843 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
|
4844 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
|
4845 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
|
4846 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
|
4847 one finds that it shouldn't. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4848 do |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4849 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4850 marked = 0; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4851 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
|
4852 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4853 h = XHASH_TABLE (table); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4854 if (h->size & ARRAY_MARK_FLAG) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4855 marked |= sweep_weak_table (h, 0); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4856 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4857 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4858 while (marked); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4859 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4860 /* 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
|
4861 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
|
4862 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4863 h = XHASH_TABLE (table); |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4864 next = h->next_weak; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4865 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4866 if (h->size & ARRAY_MARK_FLAG) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4867 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4868 /* TABLE is marked as used. Sweep its contents. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4869 if (XFASTINT (h->count) > 0) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4870 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
|
4871 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4872 /* 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
|
4873 h->next_weak = used; |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4874 used = table; |
25005
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 } |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4877 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4878 Vweak_hash_tables = used; |
25005
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 |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4883 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4884 Hash Code Computation |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4885 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4886 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4887 /* Maximum depth up to which to dive into Lisp structures. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4888 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4889 #define SXHASH_MAX_DEPTH 3 |
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 /* 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
|
4892 account. */ |
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 #define SXHASH_MAX_LEN 7 |
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 /* Combine two integers X and Y for hashing. */ |
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 #define SXHASH_COMBINE(X, Y) \ |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
4899 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4900 + (unsigned)(Y)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4901 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4902 |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4903 /* 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
|
4904 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
|
4905 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4906 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4907 sxhash_string (ptr, len) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4908 unsigned char *ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4909 int len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4910 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4911 unsigned char *p = ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4912 unsigned char *end = p + len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4913 unsigned char c; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4914 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4915 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4916 while (p != end) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4917 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4918 c = *p++; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4919 if (c >= 0140) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4920 c -= 40; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4921 hash = ((hash << 3) + (hash >> 28) + c); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4922 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4923 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4924 return hash & INTMASK; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4925 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4926 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4927 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4928 /* 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
|
4929 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
|
4930 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4931 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4932 sxhash_list (list, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4933 Lisp_Object list; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4934 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4935 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4936 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4937 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
|
4938 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4939 if (depth < SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4940 for (i = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4941 CONSP (list) && i < SXHASH_MAX_LEN; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4942 list = XCDR (list), ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4943 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4944 unsigned hash2 = sxhash (XCAR (list), depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4945 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4946 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4947 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4948 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4949 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4950 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4951 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4952 /* 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
|
4953 the Lisp structure. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4954 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4955 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4956 sxhash_vector (vec, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4957 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4958 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4959 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4960 unsigned hash = XVECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4961 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4962 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4963 n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4964 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4965 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4966 unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4967 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4968 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4969 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4970 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4971 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4972 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4973 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4974 /* Return a hash for bool-vector VECTOR. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4975 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4976 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4977 sxhash_bool_vector (vec) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4978 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4979 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4980 unsigned hash = XBOOL_VECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4981 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4982 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4983 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4984 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4985 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4986 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4987 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4988 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4989 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4990 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4991 /* 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
|
4992 structure. Value is an unsigned integer clipped to INTMASK. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4993 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4994 unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4995 sxhash (obj, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4996 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4997 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4998 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4999 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5000 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5001 if (depth > SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5002 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
|
5003 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5004 switch (XTYPE (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5005 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5006 case Lisp_Int: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5007 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5008 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5009 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5010 case Lisp_Symbol: |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
5011 hash = sxhash_string (SDATA (SYMBOL_NAME (obj)), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
5012 SCHARS (SYMBOL_NAME (obj))); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5013 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5014 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5015 case Lisp_Misc: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5016 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5017 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5018 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5019 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
|
5020 hash = sxhash_string (SDATA (obj), SCHARS (obj)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5021 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5022 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5023 /* This can be everything from a vector to an overlay. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5024 case Lisp_Vectorlike: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5025 if (VECTORP (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5026 /* 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
|
5027 they are `eq', except for strings and bit-vectors. In |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5028 Emacs, this works differently. We have to compare element |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5029 by element. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5030 hash = sxhash_vector (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5031 else if (BOOL_VECTOR_P (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5032 hash = sxhash_bool_vector (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5033 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5034 /* 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
|
5035 address as hash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5036 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5037 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5038 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5039 case Lisp_Cons: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5040 hash = sxhash_list (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5041 break; |
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 case Lisp_Float: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5044 { |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5045 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
|
5046 unsigned char *e = p + sizeof XFLOAT_DATA (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5047 for (hash = 0; p < e; ++p) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5048 hash = SXHASH_COMBINE (hash, *p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5049 break; |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5052 default: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5053 abort (); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5054 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5055 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
5056 return hash & INTMASK; |
25005
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 |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5061 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5062 Lisp Interface |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5065 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5066 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
|
5067 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
|
5068 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5069 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5070 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5071 unsigned hash = sxhash (obj, 0);; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5072 return make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5073 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5074 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5075 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5076 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
|
5077 doc: /* Create and return a new hash table. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5078 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5079 Arguments are specified as keyword/argument pairs. The following |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5080 arguments are defined: |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5081 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5082 :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
|
5083 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
|
5084 `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
|
5085 `define-hash-table-test'. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5086 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5087 :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
|
5088 Default is 65. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5089 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5090 :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
|
5091 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
|
5092 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
|
5093 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
|
5094 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5095 :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
|
5096 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
|
5097 table. Default is 0.8. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5098 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5099 :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
|
5100 `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
|
5101 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
|
5102 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
|
5103 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
|
5104 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
|
5105 is nil. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
5106 |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
5107 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
|
5108 (nargs, args) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5109 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5110 Lisp_Object *args; |
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 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5113 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5114 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5115 int i; |
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 /* 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
|
5118 have been consumed. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5119 used = (char *) alloca (nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5120 bzero (used, nargs * sizeof *used); |
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 /* See if there's a `:test TEST' among the arguments. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5123 i = get_key_arg (QCtest, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5124 test = i < 0 ? Qeql : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5125 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5126 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5127 /* See if it is a user-defined test. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5128 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
|
5129 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5130 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
|
5131 if (!CONSP (prop) || !CONSP (XCDR (prop))) |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5132 Fsignal (Qerror, list2 (build_string ("Invalid hash table test"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5133 test)); |
40734
95dd892ad5e3
(Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
5134 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
|
5135 user_hash = XCAR (XCDR (prop)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5136 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5137 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5138 user_test = user_hash = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5139 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5140 /* See if there's a `:size SIZE' argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5141 i = get_key_arg (QCsize, nargs, args, used); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5142 size = i < 0 ? Qnil : args[i]; |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5143 if (NILP (size)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5144 size = make_number (DEFAULT_HASH_SIZE); |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
5145 else if (!INTEGERP (size) || XINT (size) < 0) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5146 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5147 list2 (build_string ("Invalid hash table size"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5148 size)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5149 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5150 /* Look for `:rehash-size SIZE'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5151 i = get_key_arg (QCrehash_size, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5152 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
|
5153 if (!NUMBERP (rehash_size) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5154 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5155 || XFLOATINT (rehash_size) <= 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5156 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5157 list2 (build_string ("Invalid hash table rehash size"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5158 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
|
5159 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5160 /* Look for `:rehash-threshold THRESHOLD'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5161 i = get_key_arg (QCrehash_threshold, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5162 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
|
5163 if (!FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5164 || XFLOATINT (rehash_threshold) <= 0.0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5165 || XFLOATINT (rehash_threshold) > 1.0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5166 Fsignal (Qerror, |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5167 list2 (build_string ("Invalid hash table rehash threshold"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5168 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
|
5169 |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5170 /* Look for `:weakness WEAK'. */ |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5171 i = get_key_arg (QCweakness, nargs, args, used); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5172 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
|
5173 if (EQ (weak, Qt)) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5174 weak = Qkey_and_value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5175 if (!NILP (weak) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5176 && !EQ (weak, Qkey) |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5177 && !EQ (weak, Qvalue) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5178 && !EQ (weak, Qkey_or_value) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5179 && !EQ (weak, Qkey_and_value)) |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
5180 Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"), |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5181 weak)); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5182 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5183 /* 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
|
5184 for (i = 0; i < nargs; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5185 if (!used[i]) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5186 Fsignal (Qerror, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5187 list2 (build_string ("Invalid argument list"), args[i])); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5188 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5189 return make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5190 user_test, user_hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5191 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5192 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5193 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5194 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
|
5195 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
|
5196 (table) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5197 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5198 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5199 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
|
5200 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5201 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5202 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5203 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
|
5204 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
|
5205 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5206 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5207 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5208 return check_hash_table (table)->count; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5209 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5210 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5211 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5212 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5213 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
|
5214 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
|
5215 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5216 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5217 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5218 return check_hash_table (table)->rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5219 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5220 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5221 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5222 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5223 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
|
5224 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
|
5225 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5226 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5227 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5228 return check_hash_table (table)->rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5229 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5230 |
25005
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 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
|
5233 doc: /* Return the size of TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5234 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
|
5235 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
|
5236 without need for resizing. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5237 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5238 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5239 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5240 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5241 return make_number (HASH_TABLE_SIZE (h)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5242 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5243 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5244 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5245 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
|
5246 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
|
5247 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5248 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5249 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5250 return check_hash_table (table)->test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5251 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5252 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5253 |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5254 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
|
5255 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5256 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
|
5257 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5258 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5259 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5260 return check_hash_table (table)->weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5261 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5262 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5263 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5264 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
|
5265 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
|
5266 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5267 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5268 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5269 return HASH_TABLE_P (obj) ? Qt : Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5270 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5271 |
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 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
|
5274 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
|
5275 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5276 Lisp_Object table; |
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 hash_clear (check_hash_table (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5279 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5280 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5281 |
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 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
|
5284 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
|
5285 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
|
5286 (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
|
5287 Lisp_Object key, table, dflt; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5288 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5289 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5290 int i = hash_lookup (h, key, NULL); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5291 return i >= 0 ? HASH_VALUE (h, i) : dflt; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5292 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5293 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5294 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5295 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
|
5296 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
|
5297 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
|
5298 VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5299 (key, value, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
5300 Lisp_Object key, value, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5301 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5302 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5303 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5304 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5305 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5306 i = hash_lookup (h, key, &hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5307 if (i >= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5308 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5309 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5310 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
|
5311 |
29991
fff5fd809d11
(Fputhash): Return `value' rather than nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29979
diff
changeset
|
5312 return value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5313 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5314 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5315 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5316 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
|
5317 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
|
5318 (key, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
5319 Lisp_Object key, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5320 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5321 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5322 hash_remove (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5323 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5324 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5325 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5326 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5327 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
|
5328 doc: /* Call FUNCTION for all entries in hash table TABLE. |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5329 FUNCTION is called with 2 arguments KEY and VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5330 (function, table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5331 Lisp_Object function, table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5332 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5333 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5334 Lisp_Object args[3]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5335 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5336 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5337 for (i = 0; i < HASH_TABLE_SIZE (h); ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5338 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5339 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5340 args[0] = function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5341 args[1] = HASH_KEY (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5342 args[2] = HASH_VALUE (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5343 Ffuncall (3, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5344 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
5345 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5346 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5347 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5348 |
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 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5351 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
|
5352 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
|
5353 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5354 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
|
5355 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
|
5356 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5357 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
|
5358 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
|
5359 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
|
5360 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
|
5361 including negative integers. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5362 (name, test, hash) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5363 Lisp_Object name, test, hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5364 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5365 return Fput (name, Qhash_table_test, list2 (test, hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5366 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5367 |
28965 | 5368 |
34050 | 5369 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5370 /************************************************************************ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5371 MD5 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5372 ************************************************************************/ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5373 |
34050 | 5374 #include "md5.h" |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5375 #include "coding.h" |
34050 | 5376 |
5377 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
|
5378 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
|
5379 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5380 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
|
5381 algorithm to calculate it is defined in RFC 1321. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5382 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5383 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
|
5384 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
|
5385 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
|
5386 OBJECT. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5387 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5388 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
|
5389 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
|
5390 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
|
5391 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
|
5392 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
|
5393 file. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5394 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5395 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
|
5396 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
|
5397 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
|
5398 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5399 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
|
5400 command `prefer-coding-system') is used. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5401 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5402 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
|
5403 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
|
5404 (object, start, end, coding_system, noerror) |
34050 | 5405 Lisp_Object object, start, end, coding_system, noerror; |
5406 { | |
5407 unsigned char digest[16]; | |
5408 unsigned char value[33]; | |
5409 int i; | |
5410 int size; | |
5411 int size_byte = 0; | |
5412 int start_char = 0, end_char = 0; | |
5413 int start_byte = 0, end_byte = 0; | |
5414 register int b, e; | |
5415 register struct buffer *bp; | |
5416 int temp; | |
5417 | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5418 if (STRINGP (object)) |
34050 | 5419 { |
5420 if (NILP (coding_system)) | |
5421 { | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5422 /* 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
|
5423 |
34050 | 5424 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
|
5425 /* 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
|
5426 coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list)); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5427 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5428 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5429 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5430 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5431 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
|
5432 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5433 /* Invalid coding system. */ |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5434 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5435 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5436 coding_system = Qraw_text; |
34050 | 5437 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5438 while (1) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5439 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); |
34050 | 5440 } |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5441 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5442 if (STRING_MULTIBYTE (object)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5443 object = code_convert_string1 (object, coding_system, Qnil, 1); |
34050 | 5444 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
5445 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
|
5446 size_byte = SBYTES (object); |
34050 | 5447 |
5448 if (!NILP (start)) | |
5449 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5450 CHECK_NUMBER (start); |
34050 | 5451 |
5452 start_char = XINT (start); | |
5453 | |
5454 if (start_char < 0) | |
5455 start_char += size; | |
5456 | |
5457 start_byte = string_char_to_byte (object, start_char); | |
5458 } | |
5459 | |
5460 if (NILP (end)) | |
5461 { | |
5462 end_char = size; | |
5463 end_byte = size_byte; | |
5464 } | |
5465 else | |
5466 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5467 CHECK_NUMBER (end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5468 |
34050 | 5469 end_char = XINT (end); |
5470 | |
5471 if (end_char < 0) | |
5472 end_char += size; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5473 |
34050 | 5474 end_byte = string_char_to_byte (object, end_char); |
5475 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5476 |
34050 | 5477 if (!(0 <= start_char && start_char <= end_char && end_char <= size)) |
5478 args_out_of_range_3 (object, make_number (start_char), | |
5479 make_number (end_char)); | |
5480 } | |
5481 else | |
5482 { | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5483 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
|
5484 |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5485 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
|
5486 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5487 CHECK_BUFFER (object); |
34050 | 5488 |
5489 bp = XBUFFER (object); | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5490 if (bp != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5491 set_buffer_internal (bp); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5492 |
34050 | 5493 if (NILP (start)) |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5494 b = BEGV; |
34050 | 5495 else |
5496 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5497 CHECK_NUMBER_COERCE_MARKER (start); |
34050 | 5498 b = XINT (start); |
5499 } | |
5500 | |
5501 if (NILP (end)) | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5502 e = ZV; |
34050 | 5503 else |
5504 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5505 CHECK_NUMBER_COERCE_MARKER (end); |
34050 | 5506 e = XINT (end); |
5507 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5508 |
34050 | 5509 if (b > e) |
5510 temp = b, b = e, e = temp; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5511 |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5512 if (!(BEGV <= b && e <= ZV)) |
34050 | 5513 args_out_of_range (start, end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5514 |
34050 | 5515 if (NILP (coding_system)) |
5516 { | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5517 /* 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
|
5518 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
|
5519 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5520 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
|
5521 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
|
5522 else |
34050 | 5523 { |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5524 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
|
5525 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5526 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
|
5527 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5528 || 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
|
5529 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5530 coding_system = Qnil; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5531 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
|
5532 force_raw_text = 1; |
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 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5535 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
|
5536 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5537 /* 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
|
5538 Lisp_Object args[4], val; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5539 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5540 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
|
5541 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
|
5542 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
|
5543 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
|
5544 coding_system = XCDR (val); |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5545 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5546 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5547 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5548 && !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
|
5549 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5550 /* 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
|
5551 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
|
5552 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
|
5553 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5554 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5555 if (!force_raw_text |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5556 && !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
|
5557 /* 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
|
5558 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
|
5559 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
|
5560 coding_system, Qnil); |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5561 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5562 if (force_raw_text) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5563 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5564 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5565 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5566 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
|
5567 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5568 /* Invalid coding system. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5569 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5570 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5571 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5572 else |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5573 while (1) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5574 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); |
34050 | 5575 } |
5576 } | |
5577 | |
5578 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
|
5579 if (prev != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5580 set_buffer_internal (prev); |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5581 /* 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
|
5582 buffer. */ |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5583 specpdl_ptr--; |
34050 | 5584 |
5585 if (STRING_MULTIBYTE (object)) | |
5586 object = code_convert_string1 (object, coding_system, Qnil, 1); | |
5587 } | |
5588 | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5589 md5_buffer (SDATA (object) + start_byte, |
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5590 SBYTES (object) - (size_byte - end_byte), |
34050 | 5591 digest); |
5592 | |
5593 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
|
5594 sprintf (&value[2 * i], "%02x", digest[i]); |
34050 | 5595 value[32] = '\0'; |
5596 | |
5597 return make_string (value, 32); | |
5598 } | |
5599 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5600 |
21514 | 5601 void |
211 | 5602 syms_of_fns () |
5603 { | |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5604 /* Hash table stuff. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5605 Qhash_table_p = intern ("hash-table-p"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5606 staticpro (&Qhash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5607 Qeq = intern ("eq"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5608 staticpro (&Qeq); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5609 Qeql = intern ("eql"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5610 staticpro (&Qeql); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5611 Qequal = intern ("equal"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5612 staticpro (&Qequal); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5613 QCtest = intern (":test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5614 staticpro (&QCtest); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5615 QCsize = intern (":size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5616 staticpro (&QCsize); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5617 QCrehash_size = intern (":rehash-size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5618 staticpro (&QCrehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5619 QCrehash_threshold = intern (":rehash-threshold"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5620 staticpro (&QCrehash_threshold); |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5621 QCweakness = intern (":weakness"); |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5622 staticpro (&QCweakness); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5623 Qkey = intern ("key"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5624 staticpro (&Qkey); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5625 Qvalue = intern ("value"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5626 staticpro (&Qvalue); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5627 Qhash_table_test = intern ("hash-table-test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5628 staticpro (&Qhash_table_test); |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5629 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
|
5630 staticpro (&Qkey_or_value); |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5631 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
|
5632 staticpro (&Qkey_and_value); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5633 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5634 defsubr (&Ssxhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5635 defsubr (&Smake_hash_table); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5636 defsubr (&Scopy_hash_table); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5637 defsubr (&Shash_table_count); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5638 defsubr (&Shash_table_rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5639 defsubr (&Shash_table_rehash_threshold); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5640 defsubr (&Shash_table_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5641 defsubr (&Shash_table_test); |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5642 defsubr (&Shash_table_weakness); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5643 defsubr (&Shash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5644 defsubr (&Sclrhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5645 defsubr (&Sgethash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5646 defsubr (&Sputhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5647 defsubr (&Sremhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5648 defsubr (&Smaphash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5649 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
|
5650 |
211 | 5651 Qstring_lessp = intern ("string-lessp"); |
5652 staticpro (&Qstring_lessp); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5653 Qprovide = intern ("provide"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5654 staticpro (&Qprovide); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5655 Qrequire = intern ("require"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5656 staticpro (&Qrequire); |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
5657 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
|
5658 staticpro (&Qyes_or_no_p_history); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
5659 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
|
5660 staticpro (&Qcursor_in_echo_area); |
20004 | 5661 Qwidget_type = intern ("widget-type"); |
5662 staticpro (&Qwidget_type); | |
211 | 5663 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5664 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
|
5665 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
|
5666 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5667 require_nesting_list = Qnil; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5668 staticpro (&require_nesting_list); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5669 |
14486
3c4ba112108e
(syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents:
14456
diff
changeset
|
5670 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
|
5671 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5672 DEFVAR_LISP ("features", &Vfeatures, |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5673 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
|
5674 Used by `featurep' and `require', and altered by `provide'. */); |
211 | 5675 Vfeatures = Qnil; |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5676 Qsubfeatures = intern ("subfeatures"); |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5677 staticpro (&Qsubfeatures); |
211 | 5678 |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5679 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5680 Qcodeset = intern ("codeset"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5681 staticpro (&Qcodeset); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5682 Qdays = intern ("days"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5683 staticpro (&Qdays); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5684 Qmonths = intern ("months"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5685 staticpro (&Qmonths); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5686 Qpaper = intern ("paper"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5687 staticpro (&Qpaper); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5688 #endif /* HAVE_LANGINFO_CODESET */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5689 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5690 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
|
5691 doc: /* *Non-nil means mouse commands use dialog boxes to ask questions. |
44712 | 5692 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
|
5693 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
|
5694 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
|
5695 |
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
|
5696 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
|
5697 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
|
5698 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
|
5699 `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
|
5700 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
|
5701 use_file_dialog = 1; |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
5702 |
211 | 5703 defsubr (&Sidentity); |
5704 defsubr (&Srandom); | |
5705 defsubr (&Slength); | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
5706 defsubr (&Ssafe_length); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
5707 defsubr (&Sstring_bytes); |
211 | 5708 defsubr (&Sstring_equal); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
5709 defsubr (&Scompare_strings); |
211 | 5710 defsubr (&Sstring_lessp); |
5711 defsubr (&Sappend); | |
5712 defsubr (&Sconcat); | |
5713 defsubr (&Svconcat); | |
5714 defsubr (&Scopy_sequence); | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5715 defsubr (&Sstring_make_multibyte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5716 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
|
5717 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
|
5718 defsubr (&Sstring_as_unibyte); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
5719 defsubr (&Sstring_to_multibyte); |
211 | 5720 defsubr (&Scopy_alist); |
5721 defsubr (&Ssubstring); | |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5722 defsubr (&Ssubstring_no_properties); |
211 | 5723 defsubr (&Snthcdr); |
5724 defsubr (&Snth); | |
5725 defsubr (&Selt); | |
5726 defsubr (&Smember); | |
5727 defsubr (&Smemq); | |
5728 defsubr (&Sassq); | |
5729 defsubr (&Sassoc); | |
5730 defsubr (&Srassq); | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
5731 defsubr (&Srassoc); |
211 | 5732 defsubr (&Sdelq); |
414 | 5733 defsubr (&Sdelete); |
211 | 5734 defsubr (&Snreverse); |
5735 defsubr (&Sreverse); | |
5736 defsubr (&Ssort); | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5737 defsubr (&Splist_get); |
211 | 5738 defsubr (&Sget); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5739 defsubr (&Splist_put); |
211 | 5740 defsubr (&Sput); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5741 defsubr (&Slax_plist_get); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5742 defsubr (&Slax_plist_put); |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
5743 defsubr (&Seql); |
211 | 5744 defsubr (&Sequal); |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
5745 defsubr (&Sequal_including_properties); |
211 | 5746 defsubr (&Sfillarray); |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
5747 defsubr (&Sclear_string); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
5748 defsubr (&Schar_table_subtype); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5749 defsubr (&Schar_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5750 defsubr (&Sset_char_table_parent); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5751 defsubr (&Schar_table_extra_slot); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5752 defsubr (&Sset_char_table_extra_slot); |
13236
c9af99bb26d4
(Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents:
13184
diff
changeset
|
5753 defsubr (&Schar_table_range); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5754 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
|
5755 defsubr (&Sset_char_table_default); |
28222
33f6a8ee4733
(optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
28072
diff
changeset
|
5756 defsubr (&Soptimize_char_table); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
5757 defsubr (&Smap_char_table); |
211 | 5758 defsubr (&Snconc); |
5759 defsubr (&Smapcar); | |
28666 | 5760 defsubr (&Smapc); |
211 | 5761 defsubr (&Smapconcat); |
5762 defsubr (&Sy_or_n_p); | |
5763 defsubr (&Syes_or_no_p); | |
5764 defsubr (&Sload_average); | |
5765 defsubr (&Sfeaturep); | |
5766 defsubr (&Srequire); | |
5767 defsubr (&Sprovide); | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
5768 defsubr (&Splist_member); |
20004 | 5769 defsubr (&Swidget_put); |
5770 defsubr (&Swidget_get); | |
5771 defsubr (&Swidget_apply); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5772 defsubr (&Sbase64_encode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5773 defsubr (&Sbase64_decode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5774 defsubr (&Sbase64_encode_string); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5775 defsubr (&Sbase64_decode_string); |
34050 | 5776 defsubr (&Smd5); |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
5777 defsubr (&Slocale_info); |
211 | 5778 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5779 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5780 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5781 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5782 init_fns () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5783 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5784 Vweak_hash_tables = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5785 } |
52401 | 5786 |
5787 /* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31 | |
5788 (do not change this comment) */ |