Mercurial > emacs
annotate src/fns.c @ 99503:9d16e131644e
2008-11-12 Carsten Dominik <dominik@science.uva.nl>
* org.texi (Clocking work time): Document the :formula property of
clock tables.
(Structure editing, Refiling notes): Document refiling regions.
(Agenda commands): Document the double-prefix version
of the `l' command in the agenda.
(Handling links): Explain the effect of a double prefix
arg to `C-c C-o'.
(TODO basics): Add documentation for tag triggers.
author | Carsten Dominik <dominik@science.uva.nl> |
---|---|
date | Wed, 12 Nov 2008 08:06:54 +0000 |
parents | 7ef18b2a2781 |
children | e038c1a8307c |
rev | line source |
---|---|
211 | 1 /* Random utility Lisp functions. |
64770
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64484
diff
changeset
|
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, |
a0d1312ede66
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64484
diff
changeset
|
3 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
79759 | 4 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
211 | 5 |
6 This file is part of GNU Emacs. | |
7 | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94929
diff
changeset
|
8 GNU Emacs is free software: you can redistribute it and/or modify |
211 | 9 it under the terms of the GNU General Public License as published by |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94929
diff
changeset
|
10 the Free Software Foundation, either version 3 of the License, or |
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94929
diff
changeset
|
11 (at your option) any later version. |
211 | 12 |
13 GNU Emacs is distributed in the hope that it will be useful, | |
14 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 GNU General Public License for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94929
diff
changeset
|
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ |
211 | 20 |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4616
diff
changeset
|
21 #include <config.h> |
211 | 22 |
21514 | 23 #ifdef HAVE_UNISTD_H |
24 #include <unistd.h> | |
25 #endif | |
21841
12c75f0ef578
Include <time.h> for time.
Andreas Schwab <schwab@suse.de>
parents:
21810
diff
changeset
|
26 #include <time.h> |
21514 | 27 |
211 | 28 /* Note on some machines this defines `vector' as a typedef, |
29 so make sure we don't use that name in this file. */ | |
30 #undef vector | |
31 #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
|
32 |
211 | 33 #include "lisp.h" |
34 #include "commands.h" | |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
35 #include "character.h" |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
36 #include "coding.h" |
211 | 37 #include "buffer.h" |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
38 #include "keyboard.h" |
39697
0b986bb45526
Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39682
diff
changeset
|
39 #include "keymap.h" |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
40 #include "intervals.h" |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
41 #include "frame.h" |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
42 #include "window.h" |
37319 | 43 #include "blockinput.h" |
69957
0a13b0324d7a
[HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
69655
diff
changeset
|
44 #ifdef HAVE_MENUS |
0a13b0324d7a
[HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
69655
diff
changeset
|
45 #if defined (HAVE_X_WINDOWS) |
21514 | 46 #include "xterm.h" |
69957
0a13b0324d7a
[HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
69655
diff
changeset
|
47 #elif defined (MAC_OS) |
0a13b0324d7a
[HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
69655
diff
changeset
|
48 #include "macterm.h" |
0a13b0324d7a
[HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
69655
diff
changeset
|
49 #endif |
21514 | 50 #endif |
211 | 51 |
12062 | 52 #ifndef NULL |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
53 #define NULL ((POINTER_TYPE *)0) |
12062 | 54 #endif |
55 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
56 /* Nonzero enables use of dialog boxes for questions |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
57 asked by mouse commands. */ |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
58 int use_dialog_box; |
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
59 |
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
|
60 /* 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
|
61 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
|
62 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
|
63 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
64 extern int minibuffer_auto_raise; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
65 extern Lisp_Object minibuf_window; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
66 extern Lisp_Object Vlocale_coding_system; |
61622
aef105b11011
(Vloads_in_progress): Remove extern.
Lute Kamstra <lute@gnu.org>
parents:
61433
diff
changeset
|
67 extern int load_in_progress; |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
68 |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
69 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
|
70 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
|
71 Lisp_Object Qcursor_in_echo_area; |
20004 | 72 Lisp_Object Qwidget_type; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
73 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; |
211 | 74 |
23051
18ed8d6b11e5
(Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents:
22853
diff
changeset
|
75 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
|
76 |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
77 static int internal_equal P_ ((Lisp_Object , Lisp_Object, int, int)); |
21580
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
78 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
79 extern long get_random (); |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
80 extern void seed_random P_ ((long)); |
21580
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
81 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
82 #ifndef HAVE_UNISTD_H |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
83 extern long time (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
84 #endif |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
85 |
211 | 86 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
41006 | 87 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
|
88 (arg) |
211 | 89 Lisp_Object arg; |
90 { | |
91 return arg; | |
92 } | |
93 | |
94 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
|
95 doc: /* Return a pseudo-random number. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
96 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
|
97 On most systems, this is 29 bits' worth. |
99419
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
98 With positive integer LIMIT, return random number in interval [0,LIMIT). |
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
99 With argument t, set the random number seed from the current time and pid. |
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
100 Other values of LIMIT are ignored. */) |
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
101 (limit) |
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
102 Lisp_Object limit; |
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 |
99419
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
108 if (EQ (limit, Qt)) |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
109 seed_random (getpid () + time (NULL)); |
99419
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
110 if (NATNUMP (limit) && XFASTINT (limit) != 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. */ |
99419
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
119 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit); |
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; |
99419
7ef18b2a2781
* fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
97454
diff
changeset
|
122 while (val >= XFASTINT (limit)); |
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. |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
137 To get the number of bytes, use `string-bytes'. */) |
39977
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 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
144 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
|
145 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
|
146 else if (VECTORP (sequence)) |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
147 XSETFASTINT (val, ASIZE (sequence)); |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
148 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
|
149 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
|
150 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
|
151 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
|
152 else if (COMPILEDP (sequence)) |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
153 XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
154 else if (CONSP (sequence)) |
211 | 155 { |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
156 i = 0; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
157 while (CONSP (sequence)) |
211 | 158 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
159 sequence = XCDR (sequence); |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
160 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
161 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
162 if (!CONSP (sequence)) |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
163 break; |
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 sequence = XCDR (sequence); |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
166 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
167 QUIT; |
211 | 168 } |
169 | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
170 CHECK_LIST_END (sequence, sequence); |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
171 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
172 val = make_number (i); |
211 | 173 } |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
174 else if (NILP (sequence)) |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
175 XSETFASTINT (val, 0); |
211 | 176 else |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
177 wrong_type_argument (Qsequencep, sequence); |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
178 |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
179 return val; |
211 | 180 } |
181 | |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
182 /* This does not check for quits. That is safe since it must terminate. */ |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
183 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
184 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
|
185 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
|
186 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
|
187 it returns 0. If LIST is circular, it returns a finite value |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
188 which is at least the number of distinct elements. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
189 (list) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
190 Lisp_Object list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
191 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
192 Lisp_Object tail, halftail, length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
193 int len = 0; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
194 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
195 /* halftail is used to detect circular lists. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
196 halftail = list; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
197 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
12466
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 if (EQ (tail, halftail) && len != 0) |
12618
60c4c0fee545
(Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents:
12466
diff
changeset
|
200 break; |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
201 len++; |
13344
30e17254a280
(Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents:
13277
diff
changeset
|
202 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
|
203 halftail = XCDR (halftail); |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
204 } |
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 XSETINT (length, len); |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
207 return length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
208 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
209 |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
210 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
|
211 doc: /* Return the number of bytes in STRING. |
90667 | 212 If STRING is multibyte, this may be greater than the length of STRING. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
213 (string) |
20881
fd35cf0efd94
(Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents:
20880
diff
changeset
|
214 Lisp_Object string; |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
215 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
216 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
|
217 return make_number (SBYTES (string)); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
218 } |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
219 |
211 | 220 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
|
221 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
|
222 Case is significant, but text properties are ignored. |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
223 Symbols are also allowed; their print names are used instead. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
224 (s1, s2) |
211 | 225 register Lisp_Object s1, s2; |
226 { | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
227 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
228 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
|
229 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
230 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
|
231 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
232 CHECK_STRING (s2); |
211 | 233 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
234 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
|
235 || 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
|
236 || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1))) |
211 | 237 return Qnil; |
238 return Qt; | |
239 } | |
240 | |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
241 DEFUN ("compare-strings", Fcompare_strings, |
21673
8a32bf93da04
(Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents:
21671
diff
changeset
|
242 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
|
243 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
|
244 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
|
245 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
|
246 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
|
247 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
248 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
|
249 Unibyte strings are converted to multibyte for comparison. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
250 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
251 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
|
252 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
|
253 - 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
|
254 If string STR1 is greater, the value is a positive number N; |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
255 N - 1 is the number of characters that match at the beginning. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
256 (str1, start1, end1, str2, start2, end2, ignore_case) |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
257 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
|
258 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
259 register int end1_char, end2_char; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
260 register int i1, i1_byte, i2, i2_byte; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
261 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
262 CHECK_STRING (str1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
263 CHECK_STRING (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
264 if (NILP (start1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
265 start1 = make_number (0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
266 if (NILP (start2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
267 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
|
268 CHECK_NATNUM (start1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
269 CHECK_NATNUM (start2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
270 if (! NILP (end1)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
271 CHECK_NATNUM (end1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
272 if (! NILP (end2)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
273 CHECK_NATNUM (end2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
274 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
275 i1 = XINT (start1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
276 i2 = XINT (start2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
277 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
278 i1_byte = string_char_to_byte (str1, i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
279 i2_byte = string_char_to_byte (str2, i2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
280 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
281 end1_char = SCHARS (str1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
282 if (! NILP (end1) && end1_char > XINT (end1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
283 end1_char = XINT (end1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
284 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
285 end2_char = SCHARS (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
286 if (! NILP (end2) && end2_char > XINT (end2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
287 end2_char = XINT (end2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
288 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
289 while (i1 < end1_char && i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
290 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
291 /* When we find a mismatch, we must compare the |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
292 characters, not just the bytes. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
293 int c1, c2; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
294 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
295 if (STRING_MULTIBYTE (str1)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
296 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
|
297 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
298 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
299 c1 = SREF (str1, i1++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
300 c1 = unibyte_char_to_multibyte (c1); |
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 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
303 if (STRING_MULTIBYTE (str2)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
304 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
|
305 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
306 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
307 c2 = SREF (str2, i2++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
308 c2 = unibyte_char_to_multibyte (c2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
309 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
310 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
311 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
312 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
313 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
314 if (! NILP (ignore_case)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
315 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
316 Lisp_Object tem; |
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 tem = Fupcase (make_number (c1)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
319 c1 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
320 tem = Fupcase (make_number (c2)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
321 c2 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
322 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
323 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
324 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
325 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
326 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
327 /* Note that I1 has already been incremented |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
328 past the character that we are comparing; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
329 hence we don't add or subtract 1 here. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
330 if (c1 < c2) |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
331 return make_number (- i1 + XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
332 else |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
333 return make_number (i1 - XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
334 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
335 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
336 if (i1 < end1_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
337 return make_number (i1 - XINT (start1) + 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
338 if (i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
339 return make_number (- i1 + XINT (start1) - 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
340 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
341 return Qt; |
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 |
211 | 344 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
|
345 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
|
346 Case is significant. |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
347 Symbols are also allowed; their print names are used instead. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
348 (s1, s2) |
211 | 349 register Lisp_Object s1, s2; |
350 { | |
351 register int end; | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
352 register int i1, i1_byte, i2, i2_byte; |
211 | 353 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
354 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
355 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
|
356 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
357 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
|
358 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
359 CHECK_STRING (s2); |
211 | 360 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
361 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
|
362 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
363 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
|
364 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
|
365 end = SCHARS (s2); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
366 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
367 while (i1 < end) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
368 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
369 /* 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
|
370 characters, not just the bytes. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
371 int c1, c2; |
211 | 372 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
373 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
|
374 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
|
375 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
376 if (c1 != c2) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
377 return c1 < c2 ? Qt : Qnil; |
211 | 378 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
379 return i1 < SCHARS (s2) ? Qt : Qnil; |
211 | 380 } |
381 | |
72609
f396703cc830
(concat) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
parents:
72511
diff
changeset
|
382 #if __GNUC__ |
f396703cc830
(concat) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
parents:
72511
diff
changeset
|
383 /* "gcc -O3" enables automatic function inlining, which optimizes out |
f396703cc830
(concat) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
parents:
72511
diff
changeset
|
384 the arguments for the invocations of this function, whereas it |
f396703cc830
(concat) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
parents:
72511
diff
changeset
|
385 expects these values on the stack. */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
386 static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)) __attribute__((noinline)); |
74101
af64ed57e41e
(concat) [!__GNUC__]: Add prototype.
Eli Zaretskii <eliz@gnu.org>
parents:
73926
diff
changeset
|
387 #else /* !__GNUC__ */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
388 static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)); |
72609
f396703cc830
(concat) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
parents:
72511
diff
changeset
|
389 #endif |
211 | 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 | |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
459 |
211 | 460 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, |
48320 | 461 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
|
462 The elements of a list or vector are not copied; they are shared |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
463 with the original. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
464 (arg) |
211 | 465 Lisp_Object arg; |
466 { | |
485 | 467 if (NILP (arg)) return arg; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
468 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
469 if (CHAR_TABLE_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
470 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
471 return copy_char_table (arg); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
472 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
473 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
474 if (BOOL_VECTOR_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
475 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
476 Lisp_Object val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
477 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
478 = ((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
|
479 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
480 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
481 val = Fmake_bool_vector (Flength (arg), Qnil); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
482 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
|
483 size_in_chars); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
484 return val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
485 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
486 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
487 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
488 wrong_type_argument (Qsequencep, arg); |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
489 |
211 | 490 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); |
491 } | |
492 | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
493 /* 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
|
494 a string and has text properties to be copied. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
495 struct textprop_rec |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
496 { |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
497 int argnum; /* refer to ARGS (arguments of `concat') */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
498 int from; /* refer to ARGS[argnum] (argument string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
499 int to; /* refer to VAL (the target string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
500 }; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
501 |
211 | 502 static Lisp_Object |
503 concat (nargs, args, target_type, last_special) | |
504 int nargs; | |
505 Lisp_Object *args; | |
506 enum Lisp_Type target_type; | |
507 int last_special; | |
508 { | |
509 Lisp_Object val; | |
510 register Lisp_Object tail; | |
511 register Lisp_Object this; | |
512 int toindex; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
513 int toindex_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
514 register int result_len; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
515 register int result_len_byte; |
211 | 516 register int argnum; |
517 Lisp_Object last_tail; | |
518 Lisp_Object prev; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
519 int some_multibyte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
520 /* 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
|
521 while concatinating each string because the length of resulting |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
522 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
|
523 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
|
524 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
|
525 struct textprop_rec *textprops = NULL; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
526 /* Number of elments in textprops. */ |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
527 int num_textprops = 0; |
58623 | 528 USE_SAFE_ALLOCA; |
211 | 529 |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
530 tail = Qnil; |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
531 |
211 | 532 /* In append, the last arg isn't treated like the others */ |
533 if (last_special && nargs > 0) | |
534 { | |
535 nargs--; | |
536 last_tail = args[nargs]; | |
537 } | |
538 else | |
539 last_tail = Qnil; | |
540 | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
541 /* Check each argument. */ |
211 | 542 for (argnum = 0; argnum < nargs; argnum++) |
543 { | |
544 this = args[argnum]; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
545 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
|
546 || COMPILEDP (this) || BOOL_VECTOR_P (this))) |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
547 wrong_type_argument (Qsequencep, this); |
211 | 548 } |
549 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
550 /* 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
|
551 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
|
552 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
|
553 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
|
554 result_len_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
555 result_len = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
556 some_multibyte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
557 for (argnum = 0; argnum < nargs; argnum++) |
211 | 558 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
559 int len; |
211 | 560 this = args[argnum]; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
561 len = XFASTINT (Flength (this)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
562 if (target_type == Lisp_String) |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
563 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
564 /* 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
|
565 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
|
566 int i; |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
567 Lisp_Object ch; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
568 int this_len_byte; |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
569 |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
570 if (VECTORP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
571 for (i = 0; i < len; i++) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
572 { |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
573 ch = AREF (this, i); |
90533 | 574 CHECK_CHARACTER (ch); |
23128
45de23c16505
(concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents:
23057
diff
changeset
|
575 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
|
576 result_len_byte += this_len_byte; |
89527
7ca60ab7a039
(concat): Don't change multibyteness of the result by
Kenichi Handa <handa@m17n.org>
parents:
89483
diff
changeset
|
577 if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
578 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
579 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
580 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
|
581 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
|
582 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
|
583 for (; CONSP (this); this = XCDR (this)) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
584 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
585 ch = XCAR (this); |
90533 | 586 CHECK_CHARACTER (ch); |
23128
45de23c16505
(concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents:
23057
diff
changeset
|
587 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
|
588 result_len_byte += this_len_byte; |
89527
7ca60ab7a039
(concat): Don't change multibyteness of the result by
Kenichi Handa <handa@m17n.org>
parents:
89483
diff
changeset
|
589 if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
590 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
591 } |
20639
12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents:
20607
diff
changeset
|
592 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
593 { |
20699
907d8633c8cc
(concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents:
20667
diff
changeset
|
594 if (STRING_MULTIBYTE (this)) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
595 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
596 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
|
597 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
|
598 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
599 else |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
600 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
|
601 SCHARS (this)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
602 } |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
603 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
604 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
605 result_len += len; |
211 | 606 } |
607 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
608 if (! some_multibyte) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
609 result_len_byte = result_len; |
211 | 610 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
611 /* Create the output object. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
612 if (target_type == Lisp_Cons) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
613 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
|
614 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
|
615 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
|
616 else if (some_multibyte) |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
617 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
|
618 else |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
619 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
|
620 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
621 /* 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
|
622 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
|
623 return last_tail; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
624 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
625 /* Copy the contents of the args into the result. */ |
211 | 626 if (CONSP (val)) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
627 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ |
211 | 628 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
629 toindex = 0, toindex_byte = 0; |
211 | 630 |
631 prev = Qnil; | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
632 if (STRINGP (val)) |
58623 | 633 SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
634 |
211 | 635 for (argnum = 0; argnum < nargs; argnum++) |
636 { | |
637 Lisp_Object thislen; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
638 int thisleni = 0; |
16863
591b7a95d7a5
(concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents:
16561
diff
changeset
|
639 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
|
640 register unsigned int thisindex_byte = 0; |
211 | 641 |
642 this = args[argnum]; | |
643 if (!CONSP (this)) | |
644 thislen = Flength (this), thisleni = XINT (thislen); | |
645 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
646 /* 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
|
647 if (STRINGP (this) && STRINGP (val) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
648 && 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
|
649 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
650 int thislen_byte = SBYTES (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
651 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
652 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
|
653 SBYTES (this)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
654 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
655 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
656 textprops[num_textprops].argnum = argnum; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
657 textprops[num_textprops].from = 0; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
658 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
659 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
660 toindex_byte += thislen_byte; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
661 toindex += thisleni; |
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
662 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
|
663 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
664 /* 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
|
665 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
|
666 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
667 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
668 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
669 textprops[num_textprops].argnum = argnum; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
670 textprops[num_textprops].from = 0; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
671 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
672 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
673 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
|
674 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
|
675 SCHARS (this), 0, 1); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
676 toindex += thisleni; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
677 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
678 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
679 /* Copy element by element. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
680 while (1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
681 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
682 register Lisp_Object elt; |
211 | 683 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
684 /* 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
|
685 `this' is exhausted. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
686 if (NILP (this)) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
687 if (CONSP (this)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
688 elt = XCAR (this), this = XCDR (this); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
689 else if (thisindex >= thisleni) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
690 break; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
691 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
692 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
693 int c; |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
694 if (STRING_MULTIBYTE (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
695 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
696 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
697 thisindex, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
698 thisindex_byte); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
699 XSETFASTINT (elt, c); |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
700 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
701 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
702 { |
58265
491080266027
Avoid side-effects inside XSETFASTINT's arguments.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58239
diff
changeset
|
703 XSETFASTINT (elt, SREF (this, thisindex)); thisindex++; |
23152
7cd25ebef713
(concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents:
23128
diff
changeset
|
704 if (some_multibyte |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
705 && XINT (elt) >= 0200 |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
706 && XINT (elt) < 0400) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
707 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
708 c = unibyte_char_to_multibyte (XINT (elt)); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
709 XSETINT (elt, c); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
710 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
711 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
712 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
713 else if (BOOL_VECTOR_P (this)) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
714 { |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
715 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
716 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
|
717 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
|
718 elt = Qt; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
719 else |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
720 elt = Qnil; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
721 thisindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
722 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
723 else |
91667
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
724 { |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
725 elt = AREF (this, thisindex); |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
726 thisindex++; |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
727 } |
211 | 728 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
729 /* 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
|
730 if (toindex < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
731 { |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
732 XSETCAR (tail, elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
733 prev = tail; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
734 tail = XCDR (tail); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
735 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
736 else if (VECTORP (val)) |
91667
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
737 { |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
738 ASET (val, toindex, elt); |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
739 toindex++; |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
740 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
741 else |
211 | 742 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
743 CHECK_NUMBER (elt); |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
744 if (some_multibyte) |
89483 | 745 toindex_byte += CHAR_STRING (XINT (elt), |
746 SDATA (val) + toindex_byte); | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
747 else |
89483 | 748 SSET (val, toindex_byte++, XINT (elt)); |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
749 toindex++; |
211 | 750 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
751 } |
211 | 752 } |
485 | 753 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
|
754 XSETCDR (prev, last_tail); |
211 | 755 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
756 if (num_textprops > 0) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
757 { |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
758 Lisp_Object props; |
35352
42b56dd8986e
(concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents:
35336
diff
changeset
|
759 int last_to_end = -1; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
760 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
761 for (argnum = 0; argnum < num_textprops; argnum++) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
762 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
763 this = args[textprops[argnum].argnum]; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
764 props = text_property_list (this, |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
765 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
|
766 make_number (SCHARS (this)), |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
767 Qnil); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
768 /* 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
|
769 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
|
770 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
|
771 make_composition_value_copy (props); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
772 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
|
773 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
|
774 last_to_end = textprops[argnum].to + SCHARS (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
775 } |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
776 } |
58623 | 777 |
778 SAFE_FREE (); | |
20004 | 779 return val; |
211 | 780 } |
781 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
782 static Lisp_Object string_char_byte_cache_string; |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
783 static EMACS_INT string_char_byte_cache_charpos; |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
784 static EMACS_INT string_char_byte_cache_bytepos; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
785 |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
786 void |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
787 clear_string_char_byte_cache () |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
788 { |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
789 string_char_byte_cache_string = Qnil; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
790 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
791 |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
792 /* Return the byte index corresponding to CHAR_INDEX in STRING. */ |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
793 |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
794 EMACS_INT |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
795 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
|
796 Lisp_Object string; |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
797 EMACS_INT char_index; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
798 { |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
799 EMACS_INT i_byte; |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
800 EMACS_INT best_below, best_below_byte; |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
801 EMACS_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
|
802 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
803 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
|
804 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
|
805 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
|
806 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
|
807 return char_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
808 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
809 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
|
810 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
811 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
|
812 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
813 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
|
814 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
|
815 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
816 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
817 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
818 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
|
819 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
|
820 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
821 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
822 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
823 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
|
824 { |
89483 | 825 unsigned char *p = SDATA (string) + best_below_byte; |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
826 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
827 while (best_below < char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
828 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
829 p += BYTES_BY_CHAR_HEAD (*p); |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
830 best_below++; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
831 } |
89483 | 832 i_byte = p - SDATA (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
833 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
834 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
835 { |
89483 | 836 unsigned char *p = SDATA (string) + best_above_byte; |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
837 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
838 while (best_above > char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
839 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
840 p--; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
841 while (!CHAR_HEAD_P (*p)) p--; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
842 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
843 } |
89483 | 844 i_byte = p - SDATA (string); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
845 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
846 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
847 string_char_byte_cache_bytepos = i_byte; |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
848 string_char_byte_cache_charpos = char_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
849 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
|
850 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
851 return i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
852 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
853 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
854 /* 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
|
855 |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
856 EMACS_INT |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
857 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
|
858 Lisp_Object string; |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
859 EMACS_INT byte_index; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
860 { |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
861 EMACS_INT i, i_byte; |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
862 EMACS_INT best_below, best_below_byte; |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
863 EMACS_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
|
864 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
865 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
|
866 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
|
867 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
|
868 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
|
869 return byte_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
870 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
871 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
|
872 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
873 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
|
874 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
875 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
|
876 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
|
877 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
878 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
879 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
880 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
|
881 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
|
882 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
883 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
884 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
885 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
|
886 { |
89483 | 887 unsigned char *p = SDATA (string) + best_below_byte; |
888 unsigned char *pend = SDATA (string) + byte_index; | |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
889 |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
890 while (p < pend) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
891 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
892 p += BYTES_BY_CHAR_HEAD (*p); |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
893 best_below++; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
894 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
895 i = best_below; |
89483 | 896 i_byte = p - SDATA (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
897 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
898 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
899 { |
89483 | 900 unsigned char *p = SDATA (string) + best_above_byte; |
901 unsigned char *pbeg = SDATA (string) + byte_index; | |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
902 |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
903 while (p > pbeg) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
904 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
905 p--; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
906 while (!CHAR_HEAD_P (*p)) p--; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
907 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
908 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
909 i = best_above; |
89483 | 910 i_byte = p - SDATA (string); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
911 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
912 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
913 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
|
914 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
|
915 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
|
916 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
917 return i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
918 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
919 |
88980 | 920 /* Convert STRING to a multibyte string. */ |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
921 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
922 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
923 string_make_multibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
924 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
925 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
926 unsigned char *buf; |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
927 EMACS_INT nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
928 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
929 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
930 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
931 if (STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
932 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
933 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
934 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
|
935 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
|
936 /* 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
|
937 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
|
938 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
|
939 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
940 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
941 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
|
942 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
|
943 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
944 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
945 ret = make_multibyte_string (buf, SCHARS (string), nbytes); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
946 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
947 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
948 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
949 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
950 |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
951 |
89483 | 952 /* Convert STRING (if unibyte) to a multibyte string without changing |
953 the number of characters. Characters 0200 trough 0237 are | |
954 converted to eight-bit characters. */ | |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
955 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
956 Lisp_Object |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
957 string_to_multibyte (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
958 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
959 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
960 unsigned char *buf; |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
961 EMACS_INT nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
962 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
963 USE_SAFE_ALLOCA; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
964 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
965 if (STRING_MULTIBYTE (string)) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
966 return string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
967 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
968 nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string)); |
89483 | 969 /* If all the chars are ASCII, they won't need any more bytes once |
970 converted. */ | |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
971 if (nbytes == SBYTES (string)) |
49815
2a19e12053a4
(string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents:
49798
diff
changeset
|
972 return make_multibyte_string (SDATA (string), nbytes, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
973 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
974 SAFE_ALLOCA (buf, unsigned char *, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
975 bcopy (SDATA (string), buf, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
976 str_to_multibyte (buf, nbytes, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
977 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
978 ret = make_multibyte_string (buf, SCHARS (string), nbytes); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
979 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
980 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
981 return ret; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
982 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
983 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
984 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
985 /* 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
|
986 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
987 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
988 string_make_unibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
989 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
990 { |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
991 int nchars; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
992 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
|
993 Lisp_Object ret; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
994 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
995 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
996 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
997 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
998 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
999 nchars = SCHARS (string); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1000 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1001 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
|
1002 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
|
1003 1, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1004 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1005 ret = make_unibyte_string (buf, nchars); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
1006 SAFE_FREE (); |
56147
6b858fb89033
* fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents:
55481
diff
changeset
|
1007 |
6b858fb89033
* fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents:
55481
diff
changeset
|
1008 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1009 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1010 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1011 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
|
1012 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1013 doc: /* Return the multibyte equivalent of STRING. |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1014 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
|
1015 `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
|
1016 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
|
1017 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
|
1018 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
|
1019 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
|
1020 \(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
|
1021 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
|
1022 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1023 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1024 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1025 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1026 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1027 return string_make_multibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1028 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1029 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1030 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
|
1031 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1032 doc: /* Return the unibyte equivalent of STRING. |
45650
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1033 Multibyte character codes are converted to unibyte according to |
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1034 `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
|
1035 If the lookup in the translation table fails, this function takes just |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
1036 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
|
1037 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1038 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1039 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1040 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1041 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1042 return string_make_unibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1043 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1044 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1045 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
|
1046 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1047 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
|
1048 If STRING is unibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1049 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
|
1050 If STRING is multibyte and contains a character of charset |
89909 | 1051 `eight-bit', it is converted to the corresponding single byte. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1052 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1053 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
|
1054 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1055 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1056 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1057 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
|
1058 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1059 int bytes = SBYTES (string); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1060 unsigned char *str = (unsigned char *) xmalloc (bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1061 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1062 bcopy (SDATA (string), str, bytes); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1063 bytes = str_as_unibyte (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1064 string = make_unibyte_string (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1065 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
|
1066 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1067 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1068 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1069 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1070 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
|
1071 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1072 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
|
1073 If STRING is multibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1074 Otherwise it is a newly created string, with no text properties. |
89203
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1075 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1076 If STRING is unibyte and contains an individual 8-bit byte (i.e. not |
89203
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1077 part of a correct utf-8 sequence), it is converted to the corresponding |
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1078 multibyte character of charset `eight-bit'. |
90144
e938d7220d86
(Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents:
90143
diff
changeset
|
1079 See also `string-to-multibyte'. |
e938d7220d86
(Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents:
90143
diff
changeset
|
1080 |
61433
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1081 Beware, this often doesn't really do what you think it does. |
90144
e938d7220d86
(Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents:
90143
diff
changeset
|
1082 It is similar to (decode-coding-string STRING 'utf-8-emacs). |
61433
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1083 If you're not sure, whether to use `string-as-multibyte' or |
90144
e938d7220d86
(Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents:
90143
diff
changeset
|
1084 `string-to-multibyte', use `string-to-multibyte'. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1085 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1086 Lisp_Object string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1087 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1088 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1089 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1090 if (! STRING_MULTIBYTE (string)) |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1091 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1092 Lisp_Object new_string; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1093 int nchars, nbytes; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1094 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1095 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
|
1096 SBYTES (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1097 &nchars, &nbytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1098 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
|
1099 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
|
1100 SBYTES (string)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1101 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
|
1102 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
|
1103 SBYTES (string), NULL); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1104 string = new_string; |
46379
18cf1d2514d9
* fns.c (Fstring_as_multibyte): Use STRING_SET_INTERVALS.
Ken Raeburn <raeburn@raeburn.org>
parents:
46374
diff
changeset
|
1105 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
|
1106 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1107 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1108 } |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1109 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1110 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
|
1111 1, 1, 0, |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1112 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
|
1113 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
|
1114 Otherwise it is a newly created string, with no text properties. |
88953
b18e038d980f
(Fstring_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
88864
diff
changeset
|
1115 |
b18e038d980f
(Fstring_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
88864
diff
changeset
|
1116 If STRING is unibyte and contains an 8-bit byte, it is converted to |
89203
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1117 the corresponding multibyte character of charset `eight-bit'. |
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1118 |
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1119 This differs from `string-as-multibyte' by converting each byte of a correct |
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1120 utf-8 sequence to an eight-bit character, not just bytes that don't form a |
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1121 correct sequence. */) |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1122 (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1123 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1124 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1125 CHECK_STRING (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1126 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1127 return string_to_multibyte (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1128 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1129 |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1130 DEFUN ("string-to-unibyte", Fstring_to_unibyte, Sstring_to_unibyte, |
96502
ff7196ae78c9
(Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents:
96271
diff
changeset
|
1131 1, 1, 0, |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1132 doc: /* Return a unibyte string with the same individual chars as STRING. |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1133 If STRING is unibyte, the result is STRING itself. |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1134 Otherwise it is a newly created string, with no text properties, |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1135 where each `eight-bit' character is converted to the corresponding byte. |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1136 If STRING contains a non-ASCII, non-`eight-bit' character, |
96502
ff7196ae78c9
(Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents:
96271
diff
changeset
|
1137 an error is signaled. */) |
ff7196ae78c9
(Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents:
96271
diff
changeset
|
1138 (string) |
ff7196ae78c9
(Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents:
96271
diff
changeset
|
1139 Lisp_Object string; |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1140 { |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1141 CHECK_STRING (string); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1142 |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1143 if (STRING_MULTIBYTE (string)) |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1144 { |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1145 EMACS_INT chars = SCHARS (string); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1146 unsigned char *str = (unsigned char *) xmalloc (chars); |
96502
ff7196ae78c9
(Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents:
96271
diff
changeset
|
1147 EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, 0); |
ff7196ae78c9
(Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents:
96271
diff
changeset
|
1148 |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1149 if (converted < chars) |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1150 error ("Can't convert the %dth character to unibyte", converted); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1151 string = make_unibyte_string (str, chars); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1152 xfree (str); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1153 } |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1154 return string; |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1155 } |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1156 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1157 |
211 | 1158 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
|
1159 doc: /* Return a copy of ALIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1160 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
|
1161 but does not share the alist structure with ALIST. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1162 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
|
1163 are shared, however. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1164 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
|
1165 (alist) |
211 | 1166 Lisp_Object alist; |
1167 { | |
1168 register Lisp_Object tem; | |
1169 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1170 CHECK_LIST (alist); |
485 | 1171 if (NILP (alist)) |
211 | 1172 return alist; |
1173 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
|
1174 for (tem = alist; CONSP (tem); tem = XCDR (tem)) |
211 | 1175 { |
1176 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
|
1177 car = XCAR (tem); |
211 | 1178 |
1179 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
|
1180 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); |
211 | 1181 } |
1182 return alist; | |
1183 } | |
1184 | |
1185 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, | |
41006 | 1186 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
|
1187 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
|
1188 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
|
1189 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1190 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
|
1191 (string, from, to) |
211 | 1192 Lisp_Object string; |
1193 register Lisp_Object from, to; | |
1194 { | |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1195 Lisp_Object res; |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1196 int size; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1197 int size_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1198 int from_char, to_char; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1199 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
|
1200 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1201 CHECK_VECTOR_OR_STRING (string); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1202 CHECK_NUMBER (from); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1203 |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1204 if (STRINGP (string)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1205 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1206 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
|
1207 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1208 } |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1209 else |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
1210 size = ASIZE (string); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1211 |
485 | 1212 if (NILP (to)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1213 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1214 to_char = size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1215 to_byte = size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1216 } |
211 | 1217 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1218 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1219 CHECK_NUMBER (to); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1220 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1221 to_char = XINT (to); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1222 if (to_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1223 to_char += size; |
211 | 1224 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1225 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1226 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
|
1227 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1228 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1229 from_char = XINT (from); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1230 if (from_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1231 from_char += size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1232 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1233 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
|
1234 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1235 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
|
1236 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
|
1237 make_number (to_char)); |
211 | 1238 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1239 if (STRINGP (string)) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1240 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1241 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
|
1242 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
|
1243 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1244 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
|
1245 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
|
1246 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1247 else |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
1248 res = Fvector (to_char - from_char, &AREF (string, from_char)); |
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 return res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1251 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1252 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1253 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1254 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
|
1255 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
|
1256 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
|
1257 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
|
1258 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
|
1259 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
|
1260 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1261 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
|
1262 (string, from, to) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1263 Lisp_Object string; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1264 register Lisp_Object from, to; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1265 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1266 int size, size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1267 int from_char, to_char; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1268 int from_byte, to_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1269 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1270 CHECK_STRING (string); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1271 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1272 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
|
1273 size_byte = SBYTES (string); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1274 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1275 if (NILP (from)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1276 from_char = from_byte = 0; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1277 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1278 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1279 CHECK_NUMBER (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1280 from_char = XINT (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1281 if (from_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1282 from_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1283 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1284 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
|
1285 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1286 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1287 if (NILP (to)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1288 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1289 to_char = size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1290 to_byte = size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1291 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1292 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1293 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1294 CHECK_NUMBER (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1295 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1296 to_char = XINT (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1297 if (to_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1298 to_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1299 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1300 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
|
1301 } |
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 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
|
1304 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
|
1305 make_number (to_char)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1306 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1307 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
|
1308 to_char - from_char, to_byte - from_byte, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1309 STRING_MULTIBYTE (string)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1310 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1311 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1312 /* 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
|
1313 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
|
1314 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1315 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1316 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
|
1317 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1318 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
|
1319 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1320 Lisp_Object res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1321 int size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1322 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1323 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1324 CHECK_VECTOR_OR_STRING (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1325 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1326 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1327 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1328 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
|
1329 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1330 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1331 else |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
1332 size = ASIZE (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1333 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1334 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
|
1335 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
|
1336 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1337 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1338 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1339 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
|
1340 to - from, to_byte - from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1341 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1342 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
|
1343 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
|
1344 } |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1345 else |
74169
a2250a4829ad
(substring_both): Add missing address operator.
Juanma Barranquero <lekktu@gmail.com>
parents:
74163
diff
changeset
|
1346 res = Fvector (to - from, &AREF (string, from)); |
20004 | 1347 |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1348 return res; |
211 | 1349 } |
1350 | |
1351 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
|
1352 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
|
1353 (n, list) |
211 | 1354 Lisp_Object n; |
1355 register Lisp_Object list; | |
1356 { | |
1357 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
|
1358 CHECK_NUMBER (n); |
211 | 1359 num = XINT (n); |
485 | 1360 for (i = 0; i < num && !NILP (list); i++) |
211 | 1361 { |
1362 QUIT; | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1363 CHECK_LIST_CONS (list, list); |
26596 | 1364 list = XCDR (list); |
211 | 1365 } |
1366 return list; | |
1367 } | |
1368 | |
1369 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
|
1370 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
|
1371 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
|
1372 (n, list) |
211 | 1373 Lisp_Object n, list; |
1374 { | |
1375 return Fcar (Fnthcdr (n, list)); | |
1376 } | |
1377 | |
1378 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
|
1379 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
|
1380 (sequence, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1381 register Lisp_Object sequence, n; |
211 | 1382 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1383 CHECK_NUMBER (n); |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1384 if (CONSP (sequence) || NILP (sequence)) |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1385 return Fcar (Fnthcdr (n, sequence)); |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1386 |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1387 /* Faref signals a "not array" error, so check here. */ |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1388 CHECK_ARRAY (sequence, Qsequencep); |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1389 return Faref (sequence, n); |
211 | 1390 } |
1391 | |
1392 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
|
1393 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
|
1394 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
|
1395 (elt, list) |
211 | 1396 register Lisp_Object elt; |
1397 Lisp_Object list; | |
1398 { | |
1399 register Lisp_Object tail; | |
85330
0bc184c59770
* xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
85114
diff
changeset
|
1400 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
211 | 1401 { |
1402 register Lisp_Object tem; | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1403 CHECK_LIST_CONS (tail, list); |
26596 | 1404 tem = XCAR (tail); |
485 | 1405 if (! NILP (Fequal (elt, tem))) |
211 | 1406 return tail; |
1407 QUIT; | |
1408 } | |
1409 return Qnil; | |
1410 } | |
1411 | |
1412 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | |
73029 | 1413 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. |
1414 The value is actually the tail of LIST whose car is ELT. */) | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1415 (elt, list) |
73029 | 1416 register Lisp_Object elt, list; |
211 | 1417 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1418 while (1) |
211 | 1419 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1420 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1421 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1422 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1423 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1424 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1425 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1426 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1427 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1428 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1429 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1430 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1431 list = XCDR (list); |
211 | 1432 QUIT; |
1433 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1434 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1435 CHECK_LIST (list); |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1436 return list; |
211 | 1437 } |
1438 | |
73029 | 1439 DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, |
1440 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. | |
1441 The value is actually the tail of LIST whose car is ELT. */) | |
1442 (elt, list) | |
1443 register Lisp_Object elt; | |
1444 Lisp_Object list; | |
1445 { | |
1446 register Lisp_Object tail; | |
1447 | |
1448 if (!FLOATP (elt)) | |
1449 return Fmemq (elt, list); | |
1450 | |
85330
0bc184c59770
* xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
85114
diff
changeset
|
1451 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
73029 | 1452 { |
1453 register Lisp_Object tem; | |
1454 CHECK_LIST_CONS (tail, list); | |
1455 tem = XCAR (tail); | |
1456 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0)) | |
1457 return tail; | |
1458 QUIT; | |
1459 } | |
1460 return Qnil; | |
1461 } | |
1462 | |
211 | 1463 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
|
1464 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
|
1465 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
|
1466 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
|
1467 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1468 Lisp_Object key, list; |
211 | 1469 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1470 while (1) |
211 | 1471 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1472 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1473 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1474 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1475 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1476 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1477 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1478 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1479 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1480 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1481 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1482 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1483 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1484 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1485 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1486 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1487 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1488 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1489 list = XCDR (list); |
211 | 1490 QUIT; |
1491 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1492 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1493 return CAR (list); |
211 | 1494 } |
1495 | |
1496 /* Like Fassq but never report an error and do not allow quits. | |
1497 Use only on lists known never to be circular. */ | |
1498 | |
1499 Lisp_Object | |
1500 assq_no_quit (key, list) | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1501 Lisp_Object key, list; |
211 | 1502 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1503 while (CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1504 && (!CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1505 || !EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1506 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1507 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1508 return CAR_SAFE (list); |
211 | 1509 } |
1510 | |
1511 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
|
1512 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
|
1513 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
|
1514 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1515 Lisp_Object key, list; |
211 | 1516 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1517 Lisp_Object car; |
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 while (1) |
211 | 1520 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1521 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1522 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1523 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1524 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1525 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1526 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1527 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1528 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1529 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1530 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1531 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1532 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1533 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1534 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1535 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1536 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1537 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1538 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1539 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1540 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1541 list = XCDR (list); |
211 | 1542 QUIT; |
1543 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1544 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1545 return CAR (list); |
211 | 1546 } |
1547 | |
90408
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1548 /* Like Fassoc but never report an error and do not allow quits. |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1549 Use only on lists known never to be circular. */ |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1550 |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1551 Lisp_Object |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1552 assoc_no_quit (key, list) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1553 Lisp_Object key, list; |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1554 { |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1555 while (CONSP (list) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1556 && (!CONSP (XCAR (list)) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1557 || (!EQ (XCAR (XCAR (list)), key) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1558 && NILP (Fequal (XCAR (XCAR (list)), key))))) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1559 list = XCDR (list); |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1560 |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1561 return CONSP (list) ? XCAR (list) : Qnil; |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1562 } |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1563 |
211 | 1564 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
|
1565 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
|
1566 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
|
1567 (key, list) |
211 | 1568 register Lisp_Object key; |
1569 Lisp_Object list; | |
1570 { | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1571 while (1) |
211 | 1572 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1573 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1574 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1575 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1576 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1577 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1578 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1579 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1580 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1581 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1582 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1583 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1584 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1585 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1586 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1587 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1588 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1589 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1590 list = XCDR (list); |
211 | 1591 QUIT; |
1592 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1593 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1594 return CAR (list); |
211 | 1595 } |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1596 |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1597 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
|
1598 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
|
1599 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
|
1600 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1601 Lisp_Object key, list; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1602 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1603 Lisp_Object cdr; |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1604 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1605 while (1) |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1606 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1607 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1608 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1609 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1610 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1611 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1612 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1613 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1614 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1615 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1616 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1617 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1618 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1619 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1620 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1621 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1622 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1623 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1624 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1625 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1626 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1627 list = XCDR (list); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1628 QUIT; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1629 } |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1630 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1631 return CAR (list); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1632 } |
211 | 1633 |
1634 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
|
1635 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
|
1636 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
|
1637 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
|
1638 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
|
1639 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
|
1640 (elt, list) |
211 | 1641 register Lisp_Object elt; |
1642 Lisp_Object list; | |
1643 { | |
1644 register Lisp_Object tail, prev; | |
1645 register Lisp_Object tem; | |
1646 | |
1647 tail = list; | |
1648 prev = Qnil; | |
485 | 1649 while (!NILP (tail)) |
211 | 1650 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1651 CHECK_LIST_CONS (tail, list); |
26596 | 1652 tem = XCAR (tail); |
211 | 1653 if (EQ (elt, tem)) |
1654 { | |
485 | 1655 if (NILP (prev)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1656 list = XCDR (tail); |
211 | 1657 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1658 Fsetcdr (prev, XCDR (tail)); |
211 | 1659 } |
1660 else | |
1661 prev = tail; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1662 tail = XCDR (tail); |
211 | 1663 QUIT; |
1664 } | |
1665 return list; | |
1666 } | |
1667 | |
414 | 1668 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
|
1669 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
|
1670 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
|
1671 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
|
1672 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
|
1673 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
|
1674 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
|
1675 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
|
1676 (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
|
1677 Lisp_Object elt, seq; |
401 | 1678 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1679 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
|
1680 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
1681 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
|
1682 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1683 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
|
1684 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
|
1685 ++n; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1686 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1687 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
|
1688 { |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
1689 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
|
1690 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1691 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
|
1692 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
|
1693 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
|
1694 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1695 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
|
1696 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1697 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1698 else if (STRINGP (seq)) |
401 | 1699 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1700 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
|
1701 int c; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1702 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1703 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
|
1704 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
|
1705 ++i, ibyte += cbytes) |
401 | 1706 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1707 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
|
1708 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1709 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
|
1710 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
|
1711 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
|
1712 } |
401 | 1713 else |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1714 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1715 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
|
1716 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1717 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1718 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1719 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
|
1720 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1721 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1722 nbytes += cbytes; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1723 } |
401 | 1724 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1725 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1726 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
|
1727 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1728 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
|
1729 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1730 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
|
1731 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
|
1732 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
|
1733 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1734 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
|
1735 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
|
1736 ++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
|
1737 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1738 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
|
1739 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1740 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
|
1741 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
|
1742 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
|
1743 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1744 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1745 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1746 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
|
1747 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1748 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1749 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1750 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
|
1751 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1752 unsigned char *from = SDATA (seq) + ibyte; |
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1753 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
|
1754 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
|
1755 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1756 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1757 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
|
1758 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1759 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
|
1760 *to++ = *from++; |
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 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1763 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1764 seq = tem; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1765 } |
401 | 1766 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1767 else |
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 tail, prev; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1770 |
85330
0bc184c59770
* xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
85114
diff
changeset
|
1771 for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail)) |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1772 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1773 CHECK_LIST_CONS (tail, seq); |
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 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
|
1776 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1777 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
|
1778 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
|
1779 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1780 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
|
1781 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1782 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1783 prev = tail; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1784 QUIT; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1785 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1786 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1787 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1788 return seq; |
401 | 1789 } |
1790 | |
211 | 1791 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
|
1792 doc: /* Reverse LIST by modifying cdr pointers. |
53106 | 1793 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
|
1794 (list) |
211 | 1795 Lisp_Object list; |
1796 { | |
1797 register Lisp_Object prev, tail, next; | |
1798 | |
485 | 1799 if (NILP (list)) return list; |
211 | 1800 prev = Qnil; |
1801 tail = list; | |
485 | 1802 while (!NILP (tail)) |
211 | 1803 { |
1804 QUIT; | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1805 CHECK_LIST_CONS (tail, list); |
26596 | 1806 next = XCDR (tail); |
211 | 1807 Fsetcdr (tail, prev); |
1808 prev = tail; | |
1809 tail = next; | |
1810 } | |
1811 return prev; | |
1812 } | |
1813 | |
1814 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, | |
53106 | 1815 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
|
1816 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
|
1817 (list) |
211 | 1818 Lisp_Object list; |
1819 { | |
18421 | 1820 Lisp_Object new; |
211 | 1821 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1822 for (new = Qnil; CONSP (list); list = XCDR (list)) |
49204 | 1823 { |
1824 QUIT; | |
1825 new = Fcons (XCAR (list), new); | |
1826 } | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1827 CHECK_LIST_END (list, list); |
18421 | 1828 return new; |
211 | 1829 } |
1830 | |
1831 Lisp_Object merge (); | |
1832 | |
1833 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
|
1834 doc: /* Sort LIST, stably, comparing elements using PREDICATE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1835 Returns the sorted list. LIST is modified by side effects. |
63602 | 1836 PREDICATE is called with two elements of LIST, and should return non-nil |
65325 | 1837 if the first element should sort before the second. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1838 (list, predicate) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1839 Lisp_Object list, predicate; |
211 | 1840 { |
1841 Lisp_Object front, back; | |
1842 register Lisp_Object len, tem; | |
1843 struct gcpro gcpro1, gcpro2; | |
1844 register int length; | |
1845 | |
1846 front = list; | |
1847 len = Flength (list); | |
1848 length = XINT (len); | |
1849 if (length < 2) | |
1850 return list; | |
1851 | |
1852 XSETINT (len, (length / 2) - 1); | |
1853 tem = Fnthcdr (len, list); | |
1854 back = Fcdr (tem); | |
1855 Fsetcdr (tem, Qnil); | |
1856 | |
1857 GCPRO2 (front, back); | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1858 front = Fsort (front, predicate); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1859 back = Fsort (back, predicate); |
211 | 1860 UNGCPRO; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1861 return merge (front, back, predicate); |
211 | 1862 } |
1863 | |
1864 Lisp_Object | |
1865 merge (org_l1, org_l2, pred) | |
1866 Lisp_Object org_l1, org_l2; | |
1867 Lisp_Object pred; | |
1868 { | |
1869 Lisp_Object value; | |
1870 register Lisp_Object tail; | |
1871 Lisp_Object tem; | |
1872 register Lisp_Object l1, l2; | |
1873 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1874 | |
1875 l1 = org_l1; | |
1876 l2 = org_l2; | |
1877 tail = Qnil; | |
1878 value = Qnil; | |
1879 | |
1880 /* It is sufficient to protect org_l1 and org_l2. | |
1881 When l1 and l2 are updated, we copy the new values | |
1882 back into the org_ vars. */ | |
1883 GCPRO4 (org_l1, org_l2, pred, value); | |
1884 | |
1885 while (1) | |
1886 { | |
485 | 1887 if (NILP (l1)) |
211 | 1888 { |
1889 UNGCPRO; | |
485 | 1890 if (NILP (tail)) |
211 | 1891 return l2; |
1892 Fsetcdr (tail, l2); | |
1893 return value; | |
1894 } | |
485 | 1895 if (NILP (l2)) |
211 | 1896 { |
1897 UNGCPRO; | |
485 | 1898 if (NILP (tail)) |
211 | 1899 return l1; |
1900 Fsetcdr (tail, l1); | |
1901 return value; | |
1902 } | |
1903 tem = call2 (pred, Fcar (l2), Fcar (l1)); | |
485 | 1904 if (NILP (tem)) |
211 | 1905 { |
1906 tem = l1; | |
1907 l1 = Fcdr (l1); | |
1908 org_l1 = l1; | |
1909 } | |
1910 else | |
1911 { | |
1912 tem = l2; | |
1913 l2 = Fcdr (l2); | |
1914 org_l2 = l2; | |
1915 } | |
485 | 1916 if (NILP (tail)) |
211 | 1917 value = tem; |
1918 else | |
1919 Fsetcdr (tail, tem); | |
1920 tail = tem; | |
1921 } | |
1922 } | |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1923 |
211 | 1924 |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1925 #if 0 /* Unsafe version. */ |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1926 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
|
1927 doc: /* Extract a value from a property list. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1928 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
|
1929 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1930 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
|
1931 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
|
1932 (plist, prop) |
14051
7f7e97f219ce
(Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents:
13862
diff
changeset
|
1933 Lisp_Object plist; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1934 Lisp_Object prop; |
211 | 1935 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1936 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1937 |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1938 for (tail = plist; |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1939 CONSP (tail) && CONSP (XCDR (tail)); |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1940 tail = XCDR (XCDR (tail))) |
211 | 1941 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1942 if (EQ (prop, XCAR (tail))) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1943 return XCAR (XCDR (tail)); |
37317
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1944 |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1945 /* 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
|
1946 (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
|
1947 if (!interrupt_input_blocked) |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1948 QUIT; |
211 | 1949 } |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1950 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1951 CHECK_LIST_END (tail, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1952 |
211 | 1953 return Qnil; |
1954 } | |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1955 #endif |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1956 |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1957 /* This does not check for quits. That is safe since it must terminate. */ |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1958 |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1959 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, |
58239
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1960 doc: /* Extract a value from a property list. |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1961 PLIST is a property list, which is a list of the form |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1962 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1963 corresponding to the given PROP, or nil if PROP is not one of the |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1964 properties on the list. This function never signals an error. */) |
58239
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1965 (plist, prop) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1966 Lisp_Object plist; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1967 Lisp_Object prop; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1968 { |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1969 Lisp_Object tail, halftail; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1970 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1971 /* halftail is used to detect circular lists. */ |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1972 tail = halftail = plist; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1973 while (CONSP (tail) && CONSP (XCDR (tail))) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1974 { |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1975 if (EQ (prop, XCAR (tail))) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1976 return XCAR (XCDR (tail)); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1977 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1978 tail = XCDR (XCDR (tail)); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1979 halftail = XCDR (halftail); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1980 if (EQ (tail, halftail)) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1981 break; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1982 } |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1983 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1984 return Qnil; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1985 } |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1986 |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1987 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
|
1988 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
|
1989 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
|
1990 (symbol, propname) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1991 Lisp_Object symbol, propname; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1992 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1993 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1994 return Fplist_get (XSYMBOL (symbol)->plist, propname); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1995 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1996 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1997 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
|
1998 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
|
1999 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
|
2000 \(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
|
2001 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
|
2002 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
|
2003 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
|
2004 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
|
2005 (plist, prop, val) |
20004 | 2006 Lisp_Object plist; |
2007 register Lisp_Object prop; | |
2008 Lisp_Object val; | |
211 | 2009 { |
2010 register Lisp_Object tail, prev; | |
2011 Lisp_Object newcell; | |
2012 prev = Qnil; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2013 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
|
2014 tail = XCDR (XCDR (tail))) |
211 | 2015 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2016 if (EQ (prop, XCAR (tail))) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2017 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2018 Fsetcar (XCDR (tail), val); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2019 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2020 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2021 |
211 | 2022 prev = tail; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2023 QUIT; |
211 | 2024 } |
78824
c33d8980019c
(Fplist_put): Preserve uneven tail data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78260
diff
changeset
|
2025 newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); |
485 | 2026 if (NILP (prev)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2027 return newcell; |
211 | 2028 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2029 Fsetcdr (XCDR (prev), newcell); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2030 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2031 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2032 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2033 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
|
2034 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
|
2035 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
|
2036 (symbol, propname, value) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2037 Lisp_Object symbol, propname, value; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2038 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2039 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2040 XSYMBOL (symbol)->plist |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2041 = 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
|
2042 return value; |
211 | 2043 } |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2044 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2045 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
|
2046 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
|
2047 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
|
2048 \(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
|
2049 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
|
2050 one of the properties on the list. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2051 (plist, prop) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2052 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2053 Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2054 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2055 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2056 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2057 for (tail = plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2058 CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2059 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2060 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2061 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2062 return XCAR (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2063 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2064 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2065 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2066 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
2067 CHECK_LIST_END (tail, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2068 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2069 return Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2070 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2071 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2072 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
|
2073 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
|
2074 PLIST is a property list, which is a list of the form |
44219 | 2075 \(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
|
2076 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
|
2077 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
|
2078 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
|
2079 The PLIST is modified by side effects. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2080 (plist, prop, val) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2081 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2082 register Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2083 Lisp_Object val; |
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 register Lisp_Object tail, prev; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2086 Lisp_Object newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2087 prev = Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2088 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2089 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2090 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2091 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2092 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2093 Fsetcar (XCDR (tail), val); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2094 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2095 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2096 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2097 prev = tail; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2098 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2099 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2100 newcell = Fcons (prop, Fcons (val, Qnil)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2101 if (NILP (prev)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2102 return newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2103 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2104 Fsetcdr (XCDR (prev), newcell); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2105 return plist; |
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 |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2108 DEFUN ("eql", Feql, Seql, 2, 2, 0, |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2109 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
|
2110 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
|
2111 (obj1, obj2) |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2112 Lisp_Object obj1, obj2; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2113 { |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2114 if (FLOATP (obj1)) |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2115 return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2116 else |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2117 return EQ (obj1, obj2) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2118 } |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2119 |
211 | 2120 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
|
2121 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
|
2122 They must have the same data type. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2123 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
|
2124 Vectors and strings are compared element by element. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2125 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
|
2126 (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
|
2127 Symbols must match exactly. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2128 (o1, o2) |
211 | 2129 register Lisp_Object o1, o2; |
2130 { | |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2131 return internal_equal (o1, o2, 0, 0) ? Qt : Qnil; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2132 } |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2133 |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2134 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
|
2135 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
|
2136 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
|
2137 of strings. (`equal' ignores text properties.) */) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2138 (o1, o2) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2139 register Lisp_Object o1, o2; |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2140 { |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2141 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
|
2142 } |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2143 |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2144 /* 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
|
2145 gets too deep. |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2146 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
|
2147 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2148 static int |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2149 internal_equal (o1, o2, depth, props) |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2150 register Lisp_Object o1, o2; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2151 int depth, props; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2152 { |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2153 if (depth > 200) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2154 error ("Stack overflow in equal"); |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2155 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2156 tail_recurse: |
211 | 2157 QUIT; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2158 if (EQ (o1, o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2159 return 1; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2160 if (XTYPE (o1) != XTYPE (o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2161 return 0; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2162 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2163 switch (XTYPE (o1)) |
211 | 2164 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2165 case Lisp_Float: |
53393
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2166 { |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2167 double d1, d2; |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2168 |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2169 d1 = extract_float (o1); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2170 d2 = extract_float (o2); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2171 /* 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
|
2172 though they are not =. */ |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2173 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
|
2174 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2175 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2176 case Lisp_Cons: |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2177 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
|
2178 return 0; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2179 o1 = XCDR (o1); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2180 o2 = XCDR (o2); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2181 goto tail_recurse; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2182 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2183 case Lisp_Misc: |
11240
2642924d2d21
(internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
2184 if (XMISCTYPE (o1) != XMISCTYPE (o2)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2185 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2186 if (OVERLAYP (o1)) |
211 | 2187 { |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2188 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
|
2189 depth + 1, props) |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2190 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
2191 depth + 1, props)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2192 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2193 o1 = XOVERLAY (o1)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2194 o2 = XOVERLAY (o2)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2195 goto tail_recurse; |
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 if (MARKERP (o1)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2198 { |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2199 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
|
2200 && (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
|
2201 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); |
211 | 2202 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2203 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2204 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2205 case Lisp_Vectorlike: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2206 { |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2207 register int i; |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2208 EMACS_INT size = ASIZE (o1); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2209 /* 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
|
2210 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
|
2211 same size. */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2212 if (ASIZE (o2) != size) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2213 return 0; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2214 /* Boolvectors are compared much like strings. */ |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2215 if (BOOL_VECTOR_P (o1)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2216 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2217 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2218 = ((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
|
2219 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2220 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2221 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
|
2222 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2223 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
|
2224 size_in_chars)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2225 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2226 return 1; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2227 } |
20776
219fdecc30d3
(internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents:
20712
diff
changeset
|
2228 if (WINDOW_CONFIGURATIONP (o1)) |
21021
7be2384fabdc
(internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents:
20992
diff
changeset
|
2229 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
|
2230 |
94929
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2231 /* Aside from them, only true vectors, char-tables, compiled |
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2232 functions, and fonts (font-spec, font-entity, font-ojbect) |
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2233 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
|
2234 if (size & PSEUDOVECTOR_FLAG) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2235 { |
89483 | 2236 if (!(size & (PVEC_COMPILED |
94929
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2237 | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2238 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2239 size &= PSEUDOVECTOR_SIZE_MASK; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2240 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2241 for (i = 0; i < size; i++) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2242 { |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2243 Lisp_Object v1, v2; |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2244 v1 = AREF (o1, i); |
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2245 v2 = AREF (o2, i); |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2246 if (!internal_equal (v1, v2, depth + 1, props)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2247 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2248 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2249 return 1; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2250 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2251 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2252 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2253 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
|
2254 if (SCHARS (o1) != SCHARS (o2)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2255 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
|
2256 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
|
2257 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
|
2258 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
|
2259 SBYTES (o1))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2260 return 0; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2261 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
|
2262 return 0; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2263 return 1; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2264 |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2265 case Lisp_Int: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2266 case Lisp_Symbol: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2267 case Lisp_Type_Limit: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2268 break; |
211 | 2269 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2270 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2271 return 0; |
211 | 2272 } |
2273 | |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
2274 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
|
2275 |
211 | 2276 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
|
2277 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
|
2278 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
|
2279 (array, item) |
211 | 2280 Lisp_Object array, item; |
2281 { | |
2282 register int size, index, charval; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2283 if (VECTORP (array)) |
211 | 2284 { |
2285 register Lisp_Object *p = XVECTOR (array)->contents; | |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2286 size = ASIZE (array); |
211 | 2287 for (index = 0; index < size; index++) |
2288 p[index] = item; | |
2289 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2290 else if (CHAR_TABLE_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2291 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2292 int i; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2293 |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2294 for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++) |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2295 XCHAR_TABLE (array)->contents[i] = item; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2296 XCHAR_TABLE (array)->defalt = item; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2297 } |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2298 else if (STRINGP (array)) |
211 | 2299 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2300 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
|
2301 CHECK_NUMBER (item); |
211 | 2302 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
|
2303 size = SCHARS (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2304 if (STRING_MULTIBYTE (array)) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2305 { |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
2306 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
|
2307 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
|
2308 int size_byte = SBYTES (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2309 unsigned char *p1 = p, *endp = p + size_byte; |
23453
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2310 int i; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2311 |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2312 if (size != size_byte) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2313 while (p1 < endp) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2314 { |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2315 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2316 if (len != this_len) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2317 error ("Attempt to change byte length of a string"); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2318 p1 += this_len; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2319 } |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2320 for (i = 0; i < size_byte; i++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2321 *p++ = str[i % len]; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2322 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2323 else |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2324 for (index = 0; index < size; index++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2325 p[index] = charval; |
211 | 2326 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2327 else if (BOOL_VECTOR_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2328 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2329 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
|
2330 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2331 = ((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
|
2332 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2333 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2334 charval = (! NILP (item) ? -1 : 0); |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2335 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
|
2336 p[index] = charval; |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2337 if (index < size_in_chars) |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2338 { |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2339 /* 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
|
2340 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
|
2341 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
|
2342 p[index] = charval; |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2343 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2344 } |
211 | 2345 else |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
2346 wrong_type_argument (Qarrayp, array); |
211 | 2347 return array; |
2348 } | |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2349 |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2350 DEFUN ("clear-string", Fclear_string, Sclear_string, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2351 1, 1, 0, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2352 doc: /* Clear the contents of STRING. |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2353 This makes STRING unibyte and may change its length. */) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2354 (string) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2355 Lisp_Object string; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2356 { |
56364
78e8df7d1ad8
(Fclear_string): Correct previous change.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56361
diff
changeset
|
2357 int len; |
56358
97e94a98c666
(Fclear_string): Signal an error if STRING is not a string.
John Paul Wallington <jpw@pobox.com>
parents:
56241
diff
changeset
|
2358 CHECK_STRING (string); |
56364
78e8df7d1ad8
(Fclear_string): Correct previous change.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56361
diff
changeset
|
2359 len = SBYTES (string); |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2360 bzero (SDATA (string), len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2361 STRING_SET_CHARS (string, len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2362 STRING_SET_UNIBYTE (string); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2363 return Qnil; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2364 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2365 |
211 | 2366 /* ARGSUSED */ |
2367 Lisp_Object | |
2368 nconc2 (s1, s2) | |
2369 Lisp_Object s1, s2; | |
2370 { | |
2371 #ifdef NO_ARG_ARRAY | |
2372 Lisp_Object args[2]; | |
2373 args[0] = s1; | |
2374 args[1] = s2; | |
2375 return Fnconc (2, args); | |
2376 #else | |
2377 return Fnconc (2, &s1); | |
2378 #endif /* NO_ARG_ARRAY */ | |
2379 } | |
2380 | |
2381 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
|
2382 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
|
2383 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
|
2384 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
|
2385 (nargs, args) |
211 | 2386 int nargs; |
2387 Lisp_Object *args; | |
2388 { | |
2389 register int argnum; | |
2390 register Lisp_Object tail, tem, val; | |
2391 | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2392 val = tail = Qnil; |
211 | 2393 |
2394 for (argnum = 0; argnum < nargs; argnum++) | |
2395 { | |
2396 tem = args[argnum]; | |
485 | 2397 if (NILP (tem)) continue; |
211 | 2398 |
485 | 2399 if (NILP (val)) |
211 | 2400 val = tem; |
2401 | |
2402 if (argnum + 1 == nargs) break; | |
2403 | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
2404 CHECK_LIST_CONS (tem, tem); |
211 | 2405 |
2406 while (CONSP (tem)) | |
2407 { | |
2408 tail = tem; | |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2409 tem = XCDR (tail); |
211 | 2410 QUIT; |
2411 } | |
2412 | |
2413 tem = args[argnum + 1]; | |
2414 Fsetcdr (tail, tem); | |
485 | 2415 if (NILP (tem)) |
211 | 2416 args[argnum + 1] = tail; |
2417 } | |
2418 | |
2419 return val; | |
2420 } | |
2421 | |
2422 /* 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
|
2423 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
|
2424 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
|
2425 LENI is the length of VALS, which should also be the length of SEQ. */ |
211 | 2426 |
2427 static void | |
2428 mapcar1 (leni, vals, fn, seq) | |
2429 int leni; | |
2430 Lisp_Object *vals; | |
2431 Lisp_Object fn, seq; | |
2432 { | |
2433 register Lisp_Object tail; | |
2434 Lisp_Object dummy; | |
2435 register int i; | |
2436 struct gcpro gcpro1, gcpro2, gcpro3; | |
2437 | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2438 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2439 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2440 /* 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
|
2441 for (i = 0; i < leni; i++) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2442 vals[i] = Qnil; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2443 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2444 GCPRO3 (dummy, fn, seq); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2445 gcpro1.var = vals; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2446 gcpro1.nvars = leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2447 } |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2448 else |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2449 GCPRO2 (fn, seq); |
211 | 2450 /* We need not explicitly protect `tail' because it is used only on lists, and |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2451 1) lists are not relocated and 2) the list is marked via `seq' so will not |
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2452 be freed */ |
211 | 2453 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2454 if (VECTORP (seq)) |
211 | 2455 { |
2456 for (i = 0; i < leni; i++) | |
2457 { | |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2458 dummy = call1 (fn, AREF (seq, i)); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2459 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2460 vals[i] = dummy; |
211 | 2461 } |
2462 } | |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2463 else if (BOOL_VECTOR_P (seq)) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2464 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2465 for (i = 0; i < leni; i++) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2466 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2467 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2468 byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR]; |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2469 dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil; |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2470 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2471 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2472 vals[i] = dummy; |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2473 } |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2474 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2475 else if (STRINGP (seq)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2476 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2477 int i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2478 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2479 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
|
2480 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2481 int c; |
20712
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2482 int i_before = i; |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2483 |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2484 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
|
2485 XSETFASTINT (dummy, c); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2486 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2487 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2488 vals[i_before] = dummy; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2489 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2490 } |
211 | 2491 else /* Must be a list, since Flength did not get an error */ |
2492 { | |
2493 tail = seq; | |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
2494 for (i = 0; i < leni && CONSP (tail); i++) |
211 | 2495 { |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
2496 dummy = call1 (fn, XCAR (tail)); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2497 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2498 vals[i] = dummy; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2499 tail = XCDR (tail); |
211 | 2500 } |
2501 } | |
2502 | |
2503 UNGCPRO; | |
2504 } | |
2505 | |
2506 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
|
2507 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
|
2508 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
|
2509 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
|
2510 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
|
2511 (function, sequence, separator) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2512 Lisp_Object function, sequence, separator; |
211 | 2513 { |
2514 Lisp_Object len; | |
2515 register int leni; | |
2516 int nargs; | |
2517 register Lisp_Object *args; | |
2518 register int i; | |
2519 struct gcpro gcpro1; | |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2520 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2521 USE_SAFE_ALLOCA; |
211 | 2522 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2523 len = Flength (sequence); |
89624
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2524 if (CHAR_TABLE_P (sequence)) |
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2525 wrong_type_argument (Qlistp, sequence); |
211 | 2526 leni = XINT (len); |
2527 nargs = leni + leni - 1; | |
81283
f5adf7770714
(Fmapconcat): Use empty_unibyte_string.
Juanma Barranquero <lekktu@gmail.com>
parents:
77908
diff
changeset
|
2528 if (nargs < 0) return empty_unibyte_string; |
211 | 2529 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
2530 SAFE_ALLOCA_LISP (args, nargs); |
211 | 2531 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2532 GCPRO1 (separator); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2533 mapcar1 (leni, args, function, sequence); |
211 | 2534 UNGCPRO; |
2535 | |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
2536 for (i = leni - 1; i > 0; i--) |
211 | 2537 args[i + i] = args[i]; |
20004 | 2538 |
211 | 2539 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
|
2540 args[i] = separator; |
211 | 2541 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2542 ret = Fconcat (nargs, args); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
2543 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2544 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2545 return ret; |
211 | 2546 } |
2547 | |
2548 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
|
2549 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
|
2550 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
|
2551 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
|
2552 (function, sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2553 Lisp_Object function, sequence; |
211 | 2554 { |
2555 register Lisp_Object len; | |
2556 register int leni; | |
2557 register Lisp_Object *args; | |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2558 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2559 USE_SAFE_ALLOCA; |
211 | 2560 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2561 len = Flength (sequence); |
89624
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2562 if (CHAR_TABLE_P (sequence)) |
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2563 wrong_type_argument (Qlistp, sequence); |
211 | 2564 leni = XFASTINT (len); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2565 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
2566 SAFE_ALLOCA_LISP (args, leni); |
211 | 2567 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2568 mapcar1 (leni, args, function, sequence); |
211 | 2569 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2570 ret = Flist (leni, args); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
2571 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2572 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2573 return ret; |
211 | 2574 } |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2575 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2576 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
|
2577 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
|
2578 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
|
2579 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
|
2580 (function, sequence) |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2581 Lisp_Object function, sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2582 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2583 register int leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2584 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2585 leni = XFASTINT (Flength (sequence)); |
89624
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2586 if (CHAR_TABLE_P (sequence)) |
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2587 wrong_type_argument (Qlistp, sequence); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2588 mapcar1 (leni, 0, function, sequence); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2589 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2590 return sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2591 } |
211 | 2592 |
2593 /* Anything that calls this function must protect from GC! */ | |
2594 | |
2595 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
|
2596 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
|
2597 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
|
2598 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
|
2599 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
|
2600 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
|
2601 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
|
2602 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
|
2603 `recenter', and `quit'.\) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2604 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2605 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
|
2606 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
|
2607 (prompt) |
211 | 2608 Lisp_Object prompt; |
2609 { | |
25071 | 2610 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
|
2611 register int answer; |
211 | 2612 Lisp_Object xprompt; |
2613 Lisp_Object args[2]; | |
2614 struct gcpro gcpro1, gcpro2; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
2615 int count = SPECPDL_INDEX (); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2616 |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2617 specbind (Qcursor_in_echo_area, Qt); |
211 | 2618 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2619 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
|
2620 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2621 CHECK_STRING (prompt); |
211 | 2622 xprompt = prompt; |
2623 GCPRO2 (prompt, xprompt); | |
2624 | |
93072
e54658ddb618
* w32fns.c (hourglass_timer, hourglass_hwnd): New variables.
Jason Rumney <jasonr@gnu.org>
parents:
91807
diff
changeset
|
2625 #ifdef HAVE_WINDOW_SYSTEM |
36256
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents:
35513
diff
changeset
|
2626 if (display_hourglass_p) |
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents:
35513
diff
changeset
|
2627 cancel_hourglass (); |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
2628 #endif |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
2629 |
211 | 2630 while (1) |
2631 { | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2632 |
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
|
2633 #ifdef HAVE_MENUS |
83370
5272862a4865
Fix crashes in xdialog_show (and other places) with xterm-mouse-mode.
Karoly Lorentey <lorentey@elte.hu>
parents:
65325
diff
changeset
|
2634 if (FRAME_WINDOW_P (SELECTED_FRAME ()) |
5272862a4865
Fix crashes in xdialog_show (and other places) with xterm-mouse-mode.
Karoly Lorentey <lorentey@elte.hu>
parents:
65325
diff
changeset
|
2635 && (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
|
2636 && 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
|
2637 && 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
|
2638 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2639 Lisp_Object pane, menu; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
2640 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
|
2641 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
|
2642 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
|
2643 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
|
2644 menu = Fcons (prompt, pane); |
62674
100b8f001349
(Fyes_or_no_p, Fy_or_n_p): Call Fx_popup_dialog with
Nick Roberts <nickrob@snap.net.nz>
parents:
62139
diff
changeset
|
2645 obj = Fx_popup_dialog (Qt, menu, Qnil); |
6057
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2646 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
|
2647 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
|
2648 } |
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
|
2649 #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
|
2650 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
|
2651 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
|
2652 |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2653 { |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2654 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
|
2655 |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
2656 /* 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
|
2657 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
|
2658 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
|
2659 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
|
2660 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
|
2661 args[1] = xprompt; |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2662 Fmessage (2, args); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2663 } |
211 | 2664 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2665 if (minibuffer_auto_raise) |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2666 { |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2667 Lisp_Object mini_frame; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2668 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2669 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2670 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2671 Fraise_frame (mini_frame); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2672 } |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2673 |
83449
ff74a86c2b16
Overhaul and simplify single_kboard API. Allow calls to `recursive-edit' in process filters. Small fixes.
Karoly Lorentey <lorentey@elte.hu>
parents:
83429
diff
changeset
|
2674 temporarily_switch_to_single_kboard (SELECTED_FRAME ()); |
72136
ff262d47a1dc
(Fy_or_n_p): Change call to read_filtered_event to use new arg.
Chong Yidong <cyd@stupidchicken.com>
parents:
71979
diff
changeset
|
2675 obj = read_filtered_event (1, 0, 0, 0, Qnil); |
6850
d2d8b40fb599
(Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents:
6478
diff
changeset
|
2676 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
|
2677 /* 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
|
2678 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
|
2679 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2680 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
|
2681 def = Flookup_key (map, key, Qt); |
211 | 2682 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2683 if (EQ (def, intern ("skip"))) |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2684 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2685 answer = 0; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2686 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2687 } |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2688 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
|
2689 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2690 answer = 1; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2691 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2692 } |
2311
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2693 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
|
2694 { |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2695 Frecenter (Qnil); |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2696 xprompt = prompt; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2697 continue; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2698 } |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2699 else if (EQ (def, intern ("quit"))) |
211 | 2700 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
|
2701 /* 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
|
2702 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
|
2703 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
|
2704 Vquit_flag = Qt; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2705 |
211 | 2706 QUIT; |
1194 | 2707 |
2708 /* If we don't clear this, then the next call to read_char will | |
2709 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
|
2710 Vquit_flag = Qnil; |
211 | 2711 |
2712 Fding (Qnil); | |
2713 Fdiscard_input (); | |
2714 if (EQ (xprompt, prompt)) | |
2715 { | |
2716 args[0] = build_string ("Please answer y or n. "); | |
2717 args[1] = prompt; | |
2718 xprompt = Fconcat (2, args); | |
2719 } | |
2720 } | |
2721 UNGCPRO; | |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2722 |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2723 if (! noninteractive) |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2724 { |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2725 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
|
2726 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
|
2727 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
|
2728 } |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2729 |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2730 unbind_to (count, Qnil); |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2731 return answer ? Qt : Qnil; |
211 | 2732 } |
2733 | |
2734 /* This is how C code calls `yes-or-no-p' and allows the user | |
2735 to redefined it. | |
2736 | |
2737 Anything that calls this function must protect from GC! */ | |
2738 | |
2739 Lisp_Object | |
2740 do_yes_or_no_p (prompt) | |
2741 Lisp_Object prompt; | |
2742 { | |
2743 return call1 (intern ("yes-or-no-p"), prompt); | |
2744 } | |
2745 | |
2746 /* Anything that calls this function must protect from GC! */ | |
2747 | |
2748 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
|
2749 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
|
2750 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
|
2751 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
|
2752 The user must confirm the answer with RET, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2753 and can edit it until it has been confirmed. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2754 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2755 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
|
2756 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
|
2757 (prompt) |
211 | 2758 Lisp_Object prompt; |
2759 { | |
2760 register Lisp_Object ans; | |
2761 Lisp_Object args[2]; | |
2762 struct gcpro gcpro1; | |
2763 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2764 CHECK_STRING (prompt); |
211 | 2765 |
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
|
2766 #ifdef HAVE_MENUS |
83370
5272862a4865
Fix crashes in xdialog_show (and other places) with xterm-mouse-mode.
Karoly Lorentey <lorentey@elte.hu>
parents:
65325
diff
changeset
|
2767 if (FRAME_WINDOW_P (SELECTED_FRAME ()) |
5272862a4865
Fix crashes in xdialog_show (and other places) with xterm-mouse-mode.
Karoly Lorentey <lorentey@elte.hu>
parents:
65325
diff
changeset
|
2768 && (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
|
2769 && 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
|
2770 && 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
|
2771 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2772 Lisp_Object pane, menu, obj; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
2773 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
|
2774 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
|
2775 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
|
2776 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
|
2777 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
|
2778 menu = Fcons (prompt, pane); |
62674
100b8f001349
(Fyes_or_no_p, Fy_or_n_p): Call Fx_popup_dialog with
Nick Roberts <nickrob@snap.net.nz>
parents:
62139
diff
changeset
|
2779 obj = Fx_popup_dialog (Qt, menu, Qnil); |
6057
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2780 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
|
2781 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
|
2782 } |
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
|
2783 #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
|
2784 |
211 | 2785 args[0] = prompt; |
2786 args[1] = build_string ("(yes or no) "); | |
2787 prompt = Fconcat (2, args); | |
2788 | |
2789 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
|
2790 |
211 | 2791 while (1) |
2792 { | |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
2793 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
|
2794 Qyes_or_no_p_history, Qnil, |
70939
10be917a42fa
(Fyes_or_no_p): Fread_from_minibuffer now takes only seven args.
Luc Teirlinck <teirllm@auburn.edu>
parents:
69957
diff
changeset
|
2795 Qnil)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2796 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes")) |
211 | 2797 { |
2798 UNGCPRO; | |
2799 return Qt; | |
2800 } | |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2801 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no")) |
211 | 2802 { |
2803 UNGCPRO; | |
2804 return Qnil; | |
2805 } | |
2806 | |
2807 Fding (Qnil); | |
2808 Fdiscard_input (); | |
2809 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
|
2810 Fsleep_for (make_number (2), Qnil); |
211 | 2811 } |
2812 } | |
2813 | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2814 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
|
2815 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
|
2816 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2817 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
|
2818 to integer. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2819 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2820 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
|
2821 These floats are not multiplied by 100. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2822 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2823 If the 5-minute or 15-minute load averages are not available, return a |
51397 | 2824 shortened list, containing only those averages which are available. |
2825 | |
2826 An error is thrown if the load average can't be obtained. In some | |
2827 cases making it work would require Emacs being installed setuid or | |
2828 setgid so that it can read kernel information, and that usually isn't | |
2829 advisable. */) | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2830 (use_floats) |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2831 Lisp_Object use_floats; |
211 | 2832 { |
727 | 2833 double load_ave[3]; |
2834 int loads = getloadavg (load_ave, 3); | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2835 Lisp_Object ret = Qnil; |
211 | 2836 |
727 | 2837 if (loads < 0) |
2838 error ("load-average not implemented for this operating system"); | |
211 | 2839 |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2840 while (loads-- > 0) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2841 { |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2842 Lisp_Object load = (NILP (use_floats) ? |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2843 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
|
2844 : make_float (load_ave[loads])); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2845 ret = Fcons (load, ret); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2846 } |
211 | 2847 |
727 | 2848 return ret; |
211 | 2849 } |
2850 | |
39968
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
2851 Lisp_Object Vfeatures, Qsubfeatures; |
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
2852 extern Lisp_Object Vafter_load_alist; |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2853 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2854 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
|
2855 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
|
2856 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2857 Use this to conditionalize execution of lisp code based on the |
73686
d2a970fd4273
(Ffeaturep, syms_of_fns): Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
73049
diff
changeset
|
2858 presence or absence of Emacs or environment extensions. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2859 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
|
2860 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
|
2861 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
|
2862 (feature, subfeature) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2863 Lisp_Object feature, subfeature; |
211 | 2864 { |
2865 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
|
2866 CHECK_SYMBOL (feature); |
211 | 2867 tem = Fmemq (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2868 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
|
2869 tem = Fmember (subfeature, Fget (feature, Qsubfeatures)); |
485 | 2870 return (NILP (tem)) ? Qnil : Qt; |
211 | 2871 } |
2872 | |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2873 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
|
2874 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
|
2875 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
|
2876 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
|
2877 (feature, subfeatures) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2878 Lisp_Object feature, subfeatures; |
211 | 2879 { |
2880 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
|
2881 CHECK_SYMBOL (feature); |
44066
d0bef01f3cb3
(Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents:
41006
diff
changeset
|
2882 CHECK_LIST (subfeatures); |
485 | 2883 if (!NILP (Vautoload_queue)) |
67809
a4fcb45bffec
(Fprovide): Store (0 . OFEATURES) in Vautoload_queue.
Richard M. Stallman <rms@gnu.org>
parents:
67497
diff
changeset
|
2884 Vautoload_queue = Fcons (Fcons (make_number (0), Vfeatures), |
a4fcb45bffec
(Fprovide): Store (0 . OFEATURES) in Vautoload_queue.
Richard M. Stallman <rms@gnu.org>
parents:
67497
diff
changeset
|
2885 Vautoload_queue); |
211 | 2886 tem = Fmemq (feature, Vfeatures); |
485 | 2887 if (NILP (tem)) |
211 | 2888 Vfeatures = Fcons (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2889 if (!NILP (subfeatures)) |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2890 Fput (feature, Qsubfeatures, subfeatures); |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2891 LOADHIST_ATTACH (Fcons (Qprovide, feature)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2892 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2893 /* Run any load-hooks for this file. */ |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2894 tem = Fassq (feature, Vafter_load_alist); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2895 if (CONSP (tem)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2896 Fprogn (XCDR (tem)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2897 |
211 | 2898 return feature; |
2899 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2900 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2901 /* `require' and its subroutines. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2902 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2903 /* 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
|
2904 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2905 Lisp_Object require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2906 |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
2907 Lisp_Object |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2908 require_unwind (old_value) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2909 Lisp_Object old_value; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2910 { |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
2911 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
|
2912 } |
211 | 2913 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2914 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
|
2915 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
|
2916 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
|
2917 is not loaded; so load the file FILENAME. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2918 If FILENAME is omitted, the printname of FEATURE is used as the file name, |
52766 | 2919 and `load' will try to load this name appended with the suffix `.elc' or |
2920 `.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
|
2921 If the optional third argument NOERROR is non-nil, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2922 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
|
2923 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
|
2924 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
|
2925 (feature, filename, noerror) |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
2926 Lisp_Object feature, filename, noerror; |
211 | 2927 { |
2928 register Lisp_Object tem; | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2929 struct gcpro gcpro1, gcpro2; |
67497
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2930 int from_file = load_in_progress; |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2931 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2932 CHECK_SYMBOL (feature); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2933 |
59490
dc3b1db0bed2
(Frequire): Record in load-history unconditionally.
Richard M. Stallman <rms@gnu.org>
parents:
59146
diff
changeset
|
2934 /* Record the presence of `require' in this file |
61417
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2935 even if the feature specified is already loaded. |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2936 But not more than once in any file, |
67497
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2937 and not when we aren't loading or reading from a file. */ |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2938 if (!from_file) |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2939 for (tem = Vcurrent_load_list; CONSP (tem); tem = XCDR (tem)) |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2940 if (NILP (XCDR (tem)) && STRINGP (XCAR (tem))) |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2941 from_file = 1; |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2942 |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2943 if (from_file) |
61417
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2944 { |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2945 tem = Fcons (Qrequire, feature); |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2946 if (NILP (Fmember (tem, Vcurrent_load_list))) |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2947 LOADHIST_ATTACH (tem); |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2948 } |
211 | 2949 tem = Fmemq (feature, Vfeatures); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2950 |
485 | 2951 if (NILP (tem)) |
211 | 2952 { |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
2953 int count = SPECPDL_INDEX (); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2954 int nesting = 0; |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
2955 |
45039 | 2956 /* This is to make sure that loadup.el gives a clear picture |
2957 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
|
2958 if (! NILP (Vpurify_flag)) |
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
2959 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
|
2960 SDATA (SYMBOL_NAME (feature))); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2961 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2962 /* 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
|
2963 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
|
2964 signal an error. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2965 tem = require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2966 while (! NILP (tem)) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2967 { |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2968 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
|
2969 nesting++; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2970 tem = XCDR (tem); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2971 } |
48567
ecf43ac20827
fns.c (Frequire): Change nesting allowance from 2 to 3 to cause more
Steven Tamm <steventamm@mac.com>
parents:
48337
diff
changeset
|
2972 if (nesting > 3) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2973 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
|
2974 SDATA (SYMBOL_NAME (feature))); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2975 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2976 /* 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
|
2977 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
|
2978 require_nesting_list = Fcons (feature, require_nesting_list); |
211 | 2979 |
2980 /* Value saved here is to be restored into Vautoload_queue */ | |
2981 record_unwind_protect (un_autoload, Vautoload_queue); | |
2982 Vautoload_queue = Qt; | |
2983 | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2984 /* Load the file. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2985 GCPRO2 (feature, filename); |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
2986 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
|
2987 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
|
2988 UNGCPRO; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2989 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2990 /* If load failed entirely, return nil. */ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2991 if (NILP (tem)) |
24016
43344f47a865
(Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents:
23927
diff
changeset
|
2992 return unbind_to (count, Qnil); |
211 | 2993 |
2994 tem = Fmemq (feature, Vfeatures); | |
485 | 2995 if (NILP (tem)) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2996 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
|
2997 SDATA (SYMBOL_NAME (feature))); |
211 | 2998 |
2999 /* Once loading finishes, don't undo it. */ | |
3000 Vautoload_queue = Qt; | |
3001 feature = unbind_to (count, feature); | |
3002 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3003 |
211 | 3004 return feature; |
3005 } | |
3006 | |
20004 | 3007 /* Primitives for work of the "widget" library. |
3008 In an ideal world, this section would not have been necessary. | |
3009 However, lisp function calls being as slow as they are, it turns | |
3010 out that some functions in the widget library (wid-edit.el) are the | |
3011 bottleneck of Widget operation. Here is their translation to C, | |
3012 for the sole reason of efficiency. */ | |
3013 | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3014 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
|
3015 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
|
3016 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
|
3017 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3018 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
|
3019 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
|
3020 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
|
3021 (plist, prop) |
20004 | 3022 Lisp_Object plist, prop; |
3023 { | |
3024 while (CONSP (plist) && !EQ (XCAR (plist), prop)) | |
3025 { | |
3026 QUIT; | |
3027 plist = XCDR (plist); | |
3028 plist = CDR (plist); | |
3029 } | |
3030 return plist; | |
3031 } | |
3032 | |
3033 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
|
3034 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
|
3035 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
|
3036 (widget, property, value) |
20004 | 3037 Lisp_Object widget, property, value; |
3038 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3039 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
|
3040 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
|
3041 return value; |
20004 | 3042 } |
3043 | |
3044 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
|
3045 doc: /* In WIDGET, get the value of PROPERTY. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3046 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
|
3047 later with `widget-put'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3048 (widget, property) |
20004 | 3049 Lisp_Object widget, property; |
3050 { | |
3051 Lisp_Object tmp; | |
3052 | |
3053 while (1) | |
3054 { | |
3055 if (NILP (widget)) | |
3056 return Qnil; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3057 CHECK_CONS (widget); |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3058 tmp = Fplist_member (XCDR (widget), property); |
20004 | 3059 if (CONSP (tmp)) |
3060 { | |
3061 tmp = XCDR (tmp); | |
3062 return CAR (tmp); | |
3063 } | |
3064 tmp = XCAR (widget); | |
3065 if (NILP (tmp)) | |
3066 return Qnil; | |
3067 widget = Fget (tmp, Qwidget_type); | |
3068 } | |
3069 } | |
3070 | |
3071 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
|
3072 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
|
3073 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
|
3074 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
|
3075 (nargs, args) |
20004 | 3076 int nargs; |
3077 Lisp_Object *args; | |
3078 { | |
3079 /* This function can GC. */ | |
3080 Lisp_Object newargs[3]; | |
3081 struct gcpro gcpro1, gcpro2; | |
3082 Lisp_Object result; | |
3083 | |
3084 newargs[0] = Fwidget_get (args[0], args[1]); | |
3085 newargs[1] = args[0]; | |
3086 newargs[2] = Flist (nargs - 2, args + 2); | |
3087 GCPRO2 (newargs[0], newargs[2]); | |
3088 result = Fapply (3, newargs); | |
3089 UNGCPRO; | |
3090 return result; | |
3091 } | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3092 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3093 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3094 #include <langinfo.h> |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3095 #endif |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3096 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3097 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
|
3098 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
|
3099 ITEM should be one of the following: |
51397 | 3100 |
49798 | 3101 `codeset', returning the character set as a string (locale item CODESET); |
51397 | 3102 |
49798 | 3103 `days', returning a 7-element vector of day names (locale items DAY_n); |
51397 | 3104 |
49798 | 3105 `months', returning a 12-element vector of month names (locale items MON_n); |
51397 | 3106 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3107 `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
|
3108 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
|
3109 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3110 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
|
3111 `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
|
3112 |
49798 | 3113 See also Info node `(libc)Locales'. |
3114 | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3115 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
|
3116 (item) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3117 Lisp_Object item; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3118 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3119 char *str = NULL; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3120 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3121 Lisp_Object val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3122 if (EQ (item, Qcodeset)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3123 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3124 str = nl_langinfo (CODESET); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3125 return build_string (str); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3126 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3127 #ifdef DAY_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3128 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
|
3129 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3130 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
|
3131 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
|
3132 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3133 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3134 for (i = 0; i < 7; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3135 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3136 str = nl_langinfo (days[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3137 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
|
3138 /* 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
|
3139 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
|
3140 Faset (v, make_number (i), |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3141 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
|
3142 0)); |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3143 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3144 return v; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3145 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3146 #endif /* DAY_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3147 #ifdef MON_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3148 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
|
3149 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3150 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
|
3151 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
|
3152 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
|
3153 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3154 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3155 for (i = 0; i < 12; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3156 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3157 str = nl_langinfo (months[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3158 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
|
3159 p->contents[i] = |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
3160 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
|
3161 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3162 XSETVECTOR (val, p); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3163 return val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3164 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3165 #endif /* MON_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3166 /* 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
|
3167 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
|
3168 #ifdef PAPER_WIDTH |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3169 else if (EQ (item, Qpaper)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3170 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3171 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
|
3172 make_number (nl_langinfo (PAPER_HEIGHT))); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3173 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3174 #endif /* PAPER_WIDTH */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3175 #endif /* HAVE_LANGINFO_CODESET*/ |
51397 | 3176 return Qnil; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3177 } |
20004 | 3178 |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3179 /* 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
|
3180 Based on code from GNU recode. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3181 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3182 #define MIME_LINE_LENGTH 76 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3183 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3184 #define IS_ASCII(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3185 ((Character) < 128) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3186 #define IS_BASE64(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3187 (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
|
3188 #define IS_BASE64_IGNORABLE(Character) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3189 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3190 || (Character) == '\f' || (Character) == '\r') |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3191 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3192 /* 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
|
3193 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
|
3194 process. */ |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3195 #define READ_QUADRUPLET_BYTE(retval) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3196 do \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3197 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3198 if (i == length) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3199 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3200 if (nchars_return) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3201 *nchars_return = nchars; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3202 return (retval); \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3203 } \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3204 c = from[i++]; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3205 } \ |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3206 while (IS_BASE64_IGNORABLE (c)) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3207 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3208 /* 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
|
3209 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
|
3210 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3211 '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
|
3212 '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
|
3213 '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
|
3214 '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
|
3215 '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
|
3216 '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
|
3217 '8', '9', '+', '/' /* 60-63 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3218 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3219 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3220 /* 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
|
3221 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
|
3222 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3223 -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
|
3224 -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
|
3225 -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
|
3226 -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
|
3227 -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
|
3228 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
|
3229 -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
|
3230 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
|
3231 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
|
3232 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
|
3233 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
|
3234 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
|
3235 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
|
3236 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3237 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3238 /* 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
|
3239 get transformed into four base64 characters. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3240 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3241 .--------. .--------. .--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3242 |aaaaaabb| |bbbbcccc| |ccdddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3243 `--------' `--------' `--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3244 6 2 4 4 2 6 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3245 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3246 |00aaaaaa|00bbbbbb|00cccccc|00dddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3247 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3248 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3249 .--------+--------+--------+--------. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3250 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3251 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3252 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3253 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
|
3254 base64 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3255 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3256 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3257 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
|
3258 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
|
3259 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3260 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
|
3261 2, 3, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3262 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
|
3263 Return the length of the encoded text. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3264 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
|
3265 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3266 (beg, end, no_line_break) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3267 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
|
3268 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3269 char *encoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3270 int allength, length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3271 int ibeg, iend, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3272 int old_pos = PT; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3273 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3274 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3275 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3276 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3277 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3278 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3279 move_gap_both (XFASTINT (beg), ibeg); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3280 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3281 /* 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
|
3282 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
|
3283 characters, and then we round up. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3284 length = iend - ibeg; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3285 allength = length + length/3 + 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3286 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
|
3287 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3288 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3289 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
|
3290 NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3291 !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
|
3292 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3293 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3294 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3295 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3296 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3297 /* The encoding wasn't possible. */ |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3298 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3299 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
|
3300 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3301 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3302 /* 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
|
3303 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
|
3304 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
|
3305 insert (encoded, encoded_length); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3306 SAFE_FREE (); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3307 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
|
3308 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3309 /* 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
|
3310 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
|
3311 if (old_pos >= XFASTINT (end)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3312 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
|
3313 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
|
3314 old_pos = XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3315 SET_PT (old_pos); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3316 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3317 /* 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
|
3318 return make_number (encoded_length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3319 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3320 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3321 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
|
3322 1, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3323 doc: /* Base64-encode STRING and return the result. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3324 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
|
3325 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3326 (string, no_line_break) |
24377
f881dd22ec7d
(Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents:
24334
diff
changeset
|
3327 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
|
3328 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3329 int allength, length, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3330 char *encoded; |
23690 | 3331 Lisp_Object encoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3332 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3333 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3334 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3335 |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3336 /* 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
|
3337 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
|
3338 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
|
3339 length = SBYTES (string); |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3340 allength = length + length/3 + 1; |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3341 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
|
3342 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3343 /* 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
|
3344 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3345 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3346 encoded_length = base64_encode_1 (SDATA (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3347 encoded, length, NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3348 STRING_MULTIBYTE (string)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3349 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3350 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3351 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3352 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3353 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3354 /* The encoding wasn't possible. */ |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3355 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3356 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
|
3357 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3358 |
23690 | 3359 encoded_string = make_unibyte_string (encoded, encoded_length); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3360 SAFE_FREE (); |
23690 | 3361 |
3362 return encoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3363 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3364 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3365 static int |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3366 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
|
3367 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3368 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3369 int length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3370 int line_break; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3371 int multibyte; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3372 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3373 int counter = 0, i = 0; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3374 char *e = to; |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3375 int c; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3376 unsigned int value; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3377 int bytes; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3378 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3379 while (i < length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3380 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3381 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3382 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3383 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); |
89046
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3384 if (CHAR_BYTE8_P (c)) |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3385 c = CHAR_TO_BYTE8 (c); |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3386 else if (c >= 256) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3387 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3388 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3389 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3390 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3391 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3392 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3393 /* Wrap line every 76 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3394 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3395 if (line_break) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3396 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3397 if (counter < MIME_LINE_LENGTH / 4) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3398 counter++; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3399 else |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3400 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3401 *e++ = '\n'; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3402 counter = 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3403 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3404 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3405 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3406 /* Process first byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3407 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3408 *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
|
3409 value = (0x03 & c) << 4; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3410 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3411 /* Process second byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3412 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3413 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3414 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3415 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3416 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3417 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3418 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3419 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3420 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3421 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3422 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3423 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); |
89046
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3424 if (CHAR_BYTE8_P (c)) |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3425 c = CHAR_TO_BYTE8 (c); |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3426 else if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3427 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3428 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3429 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3430 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3431 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3432 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3433 *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
|
3434 value = (0x0f & c) << 2; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3435 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3436 /* Process third byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3437 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3438 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3439 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3440 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3441 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3442 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3443 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3444 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3445 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3446 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3447 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); |
89046
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3448 if (CHAR_BYTE8_P (c)) |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3449 c = CHAR_TO_BYTE8 (c); |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3450 else if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3451 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3452 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3453 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3454 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3455 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3456 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3457 *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
|
3458 *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
|
3459 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3460 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3461 return e - to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3462 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3463 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3464 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3465 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
|
3466 2, 2, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3467 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
|
3468 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
|
3469 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
|
3470 (beg, end) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3471 Lisp_Object beg, end; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3472 { |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3473 int ibeg, iend, length, allength; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3474 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3475 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3476 int decoded_length; |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3477 int inserted_chars; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3478 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
|
3479 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3480 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3481 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3482 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3483 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3484 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3485 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3486 length = iend - ibeg; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3487 |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3488 /* 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
|
3489 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
|
3490 most two bytes. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3491 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
|
3492 SAFE_ALLOCA (decoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3493 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3494 move_gap_both (XFASTINT (beg), ibeg); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3495 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
|
3496 multibyte, &inserted_chars); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3497 if (decoded_length > allength) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3498 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3499 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3500 if (decoded_length < 0) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3501 { |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3502 /* The decoding wasn't possible. */ |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3503 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3504 error ("Invalid base64 data"); |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3505 } |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3506 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3507 /* 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
|
3508 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
|
3509 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3510 insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0); |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3511 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3512 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3513 /* Delete the original text. */ |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3514 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
|
3515 iend + decoded_length, 1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3516 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3517 /* 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
|
3518 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
|
3519 if (old_pos >= XFASTINT (end)) |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3520 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
|
3521 else if (old_pos > XFASTINT (beg)) |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3522 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
|
3523 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
|
3524 |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3525 return make_number (inserted_chars); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3526 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3527 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3528 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
|
3529 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3530 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
|
3531 (string) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3532 Lisp_Object string; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3533 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3534 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3535 int length, decoded_length; |
23690 | 3536 Lisp_Object decoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3537 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3538 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3539 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3540 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3541 length = SBYTES (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3542 /* 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
|
3543 SAFE_ALLOCA (decoded, char *, length); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3544 |
32753
401f661f11d4
2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
32351
diff
changeset
|
3545 /* 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
|
3546 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
|
3547 0, NULL); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3548 if (decoded_length > length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3549 abort (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
3550 else if (decoded_length >= 0) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3551 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
|
3552 else |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3553 decoded_string = Qnil; |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3554 |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3555 SAFE_FREE (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
3556 if (!STRINGP (decoded_string)) |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3557 error ("Invalid base64 data"); |
23690 | 3558 |
3559 return decoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3560 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3561 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3562 /* 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
|
3563 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
|
3564 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
|
3565 characters in *NCHARS_RETURN. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3566 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3567 static int |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3568 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
|
3569 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3570 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3571 int length; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3572 int multibyte; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3573 int *nchars_return; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3574 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3575 int i = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3576 char *e = to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3577 unsigned char c; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3578 unsigned long value; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3579 int nchars = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3580 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3581 while (1) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3582 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3583 /* Process first byte of a quadruplet. */ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3584 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3585 READ_QUADRUPLET_BYTE (e-to); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3586 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3587 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3588 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3589 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
|
3590 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3591 /* Process second byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3592 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3593 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3594 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3595 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3596 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3597 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
|
3598 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3599 c = (unsigned char) (value >> 16); |
89039
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3600 if (multibyte && c >= 128) |
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3601 e += BYTE8_STRING (c, e); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3602 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3603 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3604 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3605 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3606 /* 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
|
3607 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3608 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3609 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3610 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3611 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3612 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
|
3613 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3614 if (c != '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3615 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3616 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3617 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3618 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3619 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3620 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3621 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
|
3622 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3623 c = (unsigned char) (0xff & value >> 8); |
89039
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3624 if (multibyte && c >= 128) |
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3625 e += BYTE8_STRING (c, e); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3626 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3627 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3628 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3629 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3630 /* Process fourth byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3631 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3632 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3633 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3634 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3635 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3636 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3637 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3638 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3639 value |= base64_char_to_value[c]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3640 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3641 c = (unsigned char) (0xff & value); |
89039
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3642 if (multibyte && c >= 128) |
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3643 e += BYTE8_STRING (c, e); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3644 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3645 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3646 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3647 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3648 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3649 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3650 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3651 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3652 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3653 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3654 ***** Hash Tables ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3655 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3656 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3657 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3658 /* Implemented by gerd@gnu.org. This hash table implementation was |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3659 inspired by CMUCL hash tables. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3660 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3661 /* Ideas: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3662 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3663 1. For small tables, association lists are probably faster than |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3664 hash tables because they have lower overhead. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3665 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3666 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
|
3667 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
|
3668 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
|
3669 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
|
3670 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
|
3671 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3672 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3673 /* 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
|
3674 |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
3675 struct Lisp_Hash_Table *weak_hash_tables; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3676 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3677 /* Various symbols. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3678 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
3679 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue; |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
3680 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
|
3681 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
|
3682 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3683 /* Function prototypes. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3684 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3685 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
|
3686 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
|
3687 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
|
3688 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
|
3689 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3690 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
|
3691 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3692 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
|
3693 unsigned, Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3694 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
|
3695 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
|
3696 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
|
3697 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3698 Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3699 static unsigned sxhash_string P_ ((unsigned char *, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3700 static unsigned sxhash_list P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3701 static unsigned sxhash_vector P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3702 static unsigned sxhash_bool_vector P_ ((Lisp_Object)); |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
3703 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
|
3704 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3705 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3706 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3707 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3708 Utilities |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3709 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3710 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3711 /* 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
|
3712 Lisp_Hash_Table. Otherwise, signal an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3713 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3714 static struct Lisp_Hash_Table * |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3715 check_hash_table (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3716 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3717 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3718 CHECK_HASH_TABLE (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3719 return XHASH_TABLE (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3720 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3721 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3722 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3723 /* 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
|
3724 number. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3725 |
29979
6fe8f444b6a3
(next_almost_prime): Make it externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
29953
diff
changeset
|
3726 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3727 next_almost_prime (n) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3728 int n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3729 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3730 if (n % 2 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3731 n += 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3732 if (n % 3 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3733 n += 2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3734 if (n % 7 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3735 n += 4; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3736 return n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3737 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3738 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3739 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3740 /* 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
|
3741 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
|
3742 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
|
3743 -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
|
3744 a DEFUN parameter list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3745 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3746 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3747 get_key_arg (key, nargs, args, used) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3748 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3749 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3750 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3751 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3752 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3753 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
|
3754 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3755 for (i = 0; i < nargs - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3756 if (!used[i] && EQ (args[i], key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3757 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3758 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3759 if (i >= nargs - 1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3760 i = -1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3761 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3762 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3763 used[i++] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3764 used[i] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3765 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3766 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3767 return i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3768 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3769 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3770 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3771 /* 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
|
3772 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
|
3773 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
|
3774 |
28481
3caab3235bc1
(larger_vector): Make externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
28222
diff
changeset
|
3775 Lisp_Object |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3776 larger_vector (vec, new_size, init) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3777 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3778 int new_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3779 Lisp_Object init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3780 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3781 struct Lisp_Vector *v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3782 int i, old_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3783 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3784 xassert (VECTORP (vec)); |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
3785 old_size = ASIZE (vec); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3786 xassert (new_size >= old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3787 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3788 v = allocate_vector (new_size); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3789 bcopy (XVECTOR (vec)->contents, v->contents, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3790 old_size * sizeof *v->contents); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3791 for (i = old_size; i < new_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3792 v->contents[i] = init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3793 XSETVECTOR (vec, v); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3794 return vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3795 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3796 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3797 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3798 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3799 Low-level Functions |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3800 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3801 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3802 /* 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
|
3803 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
|
3804 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3805 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3806 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3807 cmpfn_eql (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3808 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3809 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3810 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3811 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3812 return (FLOATP (key1) |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3813 && FLOATP (key2) |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
3814 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3815 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3816 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3817 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3818 /* 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
|
3819 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
|
3820 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3821 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3822 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3823 cmpfn_equal (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3824 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3825 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3826 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3827 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3828 return hash1 == hash2 && !NILP (Fequal (key1, key2)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3829 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3830 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3831 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3832 /* 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
|
3833 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
|
3834 if KEY1 and KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3835 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3836 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3837 cmpfn_user_defined (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3838 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3839 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3840 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3841 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3842 if (hash1 == hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3843 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3844 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
|
3845 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3846 args[0] = h->user_cmp_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3847 args[1] = key1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3848 args[2] = key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3849 return !NILP (Ffuncall (3, args)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3850 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3851 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3852 return 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3853 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3854 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3855 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3856 /* 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
|
3857 `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
|
3858 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3859 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3860 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3861 hashfn_eq (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3862 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3863 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3864 { |
90970
3371fc48749b
Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
90918
diff
changeset
|
3865 unsigned hash = XUINT (key) ^ XTYPE (key); |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
3866 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3867 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3868 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3869 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3870 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3871 /* 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
|
3872 `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
|
3873 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3874 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3875 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3876 hashfn_eql (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3877 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3878 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3879 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3880 unsigned hash; |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3881 if (FLOATP (key)) |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3882 hash = sxhash (key, 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3883 else |
90970
3371fc48749b
Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
90918
diff
changeset
|
3884 hash = XUINT (key) ^ XTYPE (key); |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
3885 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3886 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3887 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3888 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3889 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3890 /* 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
|
3891 `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
|
3892 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3893 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3894 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3895 hashfn_equal (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3896 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3897 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3898 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3899 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
|
3900 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3901 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3902 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3903 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3904 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3905 /* 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
|
3906 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
|
3907 guaranteed to fit in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3908 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3909 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3910 hashfn_user_defined (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3911 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3912 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3913 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3914 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
|
3915 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3916 args[0] = h->user_hash_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3917 args[1] = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3918 hash = Ffuncall (2, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3919 if (!INTEGERP (hash)) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
3920 signal_error ("Invalid hash code returned from user-supplied hash function", hash); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3921 return XUINT (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3922 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3923 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3924 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3925 /* Create and initialize a new hash table. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3926 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3927 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
|
3928 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
|
3929 `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
|
3930 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
|
3931 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3932 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
|
3933 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3934 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
|
3935 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
|
3936 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
|
3937 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
|
3938 REHASH_SIZE. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3939 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3940 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
|
3941 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
|
3942 (table size) is >= REHASH_THRESHOLD. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3943 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3944 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
|
3945 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
|
3946 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3947 Lisp_Object |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3948 make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3949 user_test, user_hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3950 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3951 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3952 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3953 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3954 Lisp_Object table; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3955 int index_size, i, sz; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3956 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3957 /* Preconditions. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3958 xassert (SYMBOLP (test)); |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3959 xassert (INTEGERP (size) && XINT (size) >= 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3960 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3961 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3962 xassert (FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3963 && XFLOATINT (rehash_threshold) > 0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3964 && XFLOATINT (rehash_threshold) <= 1.0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3965 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3966 if (XFASTINT (size) == 0) |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3967 size = make_number (1); |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3968 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3969 /* Allocate a table and initialize it. */ |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3970 h = allocate_hash_table (); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3971 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3972 /* Initialize hash table slots. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3973 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
|
3974 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3975 h->test = test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3976 if (EQ (test, Qeql)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3977 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3978 h->cmpfn = cmpfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3979 h->hashfn = hashfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3980 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3981 else if (EQ (test, Qeq)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3982 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3983 h->cmpfn = NULL; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3984 h->hashfn = hashfn_eq; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3985 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3986 else if (EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3987 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3988 h->cmpfn = cmpfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3989 h->hashfn = hashfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3990 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3991 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3992 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3993 h->user_cmp_function = user_test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3994 h->user_hash_function = user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3995 h->cmpfn = cmpfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3996 h->hashfn = hashfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3997 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3998 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3999 h->weak = weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4000 h->rehash_threshold = rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4001 h->rehash_size = rehash_size; |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4002 h->count = 0; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4003 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
|
4004 h->hash = Fmake_vector (size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4005 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
|
4006 /* 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
|
4007 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
|
4008 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4009 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4010 /* Set up the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4011 for (i = 0; i < sz - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4012 HASH_NEXT (h, i) = make_number (i + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4013 h->next_free = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4014 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4015 XSET_HASH_TABLE (table, h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4016 xassert (HASH_TABLE_P (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4017 xassert (XHASH_TABLE (table) == h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4018 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4019 /* 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
|
4020 if (NILP (h->weak)) |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4021 h->next_weak = NULL; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4022 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4023 { |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4024 h->next_weak = weak_hash_tables; |
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4025 weak_hash_tables = h; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4026 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4027 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4028 return table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4029 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4030 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4031 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4032 /* 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
|
4033 only the table itself is. */ |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4034 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4035 Lisp_Object |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4036 copy_hash_table (h1) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4037 struct Lisp_Hash_Table *h1; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4038 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4039 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4040 struct Lisp_Hash_Table *h2; |
40769
fa1546836808
(copy_hash_table): Remove unused variable `v'.
Pavel Janík <Pavel@Janik.cz>
parents:
40734
diff
changeset
|
4041 struct Lisp_Vector *next; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4042 |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4043 h2 = allocate_hash_table (); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4044 next = h2->vec_next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4045 bcopy (h1, h2, sizeof *h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4046 h2->vec_next = next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4047 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
|
4048 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
|
4049 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
|
4050 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
|
4051 XSET_HASH_TABLE (table, h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4052 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4053 /* 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
|
4054 if (!NILP (h2->weak)) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4055 { |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4056 h2->next_weak = weak_hash_tables; |
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4057 weak_hash_tables = h2; |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4058 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4059 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4060 return table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4061 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4062 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4063 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4064 /* 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
|
4065 because it's already too large, throw an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4066 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4067 static INLINE void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4068 maybe_resize_hash_table (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4069 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4070 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4071 if (NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4072 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4073 int old_size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4074 int i, new_size, index_size; |
75218
6a5ce97ea40d
(maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents:
74169
diff
changeset
|
4075 EMACS_INT nsize; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4076 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4077 if (INTEGERP (h->rehash_size)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4078 new_size = old_size + XFASTINT (h->rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4079 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4080 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
|
4081 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
|
4082 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
|
4083 (new_size |
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4084 / XFLOATINT (h->rehash_threshold))); |
75218
6a5ce97ea40d
(maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents:
74169
diff
changeset
|
4085 /* Assignment to EMACS_INT stops GCC whining about limited range |
6a5ce97ea40d
(maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents:
74169
diff
changeset
|
4086 of data type. */ |
6a5ce97ea40d
(maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents:
74169
diff
changeset
|
4087 nsize = max (index_size, 2 * new_size); |
6a5ce97ea40d
(maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents:
74169
diff
changeset
|
4088 if (nsize > MOST_POSITIVE_FIXNUM) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4089 error ("Hash table too large to resize"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4090 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4091 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
|
4092 h->next = larger_vector (h->next, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4093 h->hash = larger_vector (h->hash, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4094 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4095 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4096 /* 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
|
4097 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
|
4098 maphash faster. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4099 for (i = old_size; i < new_size - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4100 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
|
4101 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4102 if (!NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4103 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4104 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
|
4105 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4106 last = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4107 while (next = HASH_NEXT (h, XFASTINT (last)), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4108 !NILP (next)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4109 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
|
4110 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4111 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); |
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 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4114 XSETFASTINT (h->next_free, old_size); |
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 /* Rehash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4117 for (i = 0; i < old_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4118 if (!NILP (HASH_HASH (h, i))) |
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 unsigned hash_code = XUINT (HASH_HASH (h, i)); |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4121 int start_of_bucket = hash_code % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4122 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4123 HASH_INDEX (h, start_of_bucket) = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4124 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4125 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4126 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4127 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4128 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4129 /* 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
|
4130 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
|
4131 matching KEY, or -1 if not found. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4132 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4133 int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4134 hash_lookup (h, key, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4135 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4136 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4137 unsigned *hash; |
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 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4140 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4141 Lisp_Object idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4142 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4143 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4144 if (hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4145 *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
|
4146 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4147 start_of_bucket = hash_code % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4148 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4149 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4150 /* 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
|
4151 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4152 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4153 int i = XFASTINT (idx); |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4154 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
|
4155 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4156 && 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
|
4157 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4158 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4159 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4160 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4161 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4162 return NILP (idx) ? -1 : XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4163 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4164 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4165 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4166 /* 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
|
4167 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
|
4168 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
|
4169 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4170 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4171 hash_put (h, key, value, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4172 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4173 Lisp_Object key, value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4174 unsigned hash; |
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 int start_of_bucket, i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4177 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4178 xassert ((hash & ~INTMASK) == 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4179 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4180 /* Increment count after resizing because resizing may fail. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4181 maybe_resize_hash_table (h); |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4182 h->count++; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4183 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4184 /* Store key/value in the key_and_value vector. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4185 i = XFASTINT (h->next_free); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4186 h->next_free = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4187 HASH_KEY (h, i) = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4188 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4189 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4190 /* Remember its hash code. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4191 HASH_HASH (h, i) = make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4192 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4193 /* Add new entry to its collision chain. */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4194 start_of_bucket = hash % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4195 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4196 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
|
4197 return i; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4198 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4199 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4200 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4201 /* 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
|
4202 |
96764
1307c33f5e9a
* ecrt0.c: Remove code depending on m68000, not used anymore.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
96502
diff
changeset
|
4203 static void |
96815
be932007d518
by renaming, get rid of need for hash_remove() redefinitions for NS platform; also, adjust nsgui dependencies in Makefile
Adrian Robert <Adrian.B.Robert@gmail.com>
parents:
96764
diff
changeset
|
4204 hash_remove_from_table (h, key) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4205 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4206 Lisp_Object key; |
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 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4209 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4210 Lisp_Object idx, prev; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4211 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4212 hash_code = h->hashfn (h, key); |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4213 start_of_bucket = hash_code % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4214 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4215 prev = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4216 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4217 /* 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
|
4218 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4219 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4220 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4221 |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4222 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
|
4223 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4224 && 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
|
4225 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4226 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4227 /* Take entry out of collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4228 if (NILP (prev)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4229 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4230 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4231 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); |
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 /* 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
|
4234 the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4235 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
|
4236 HASH_NEXT (h, i) = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4237 h->next_free = make_number (i); |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4238 h->count--; |
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4239 xassert (h->count >= 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4240 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4241 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4242 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4243 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4244 prev = idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4245 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4246 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4247 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4248 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4249 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4250 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4251 /* Clear hash table H. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4252 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4253 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4254 hash_clear (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4255 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4256 { |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4257 if (h->count > 0) |
25005
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 int i, size = HASH_TABLE_SIZE (h); |
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 for (i = 0; i < size; ++i) |
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 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
|
4264 HASH_KEY (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4265 HASH_VALUE (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4266 HASH_HASH (h, i) = Qnil; |
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 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4269 for (i = 0; i < ASIZE (h->index); ++i) |
91667
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
4270 ASET (h->index, i, Qnil); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4271 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4272 h->next_free = make_number (0); |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4273 h->count = 0; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4274 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4275 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4276 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4277 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4278 |
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 Weak Hash Tables |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4281 ************************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4282 |
94992
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4283 void |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4284 init_weak_hash_tables () |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4285 { |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4286 weak_hash_tables = NULL; |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4287 } |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4288 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4289 /* 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
|
4290 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
|
4291 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
|
4292 non-zero if anything was marked. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4293 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4294 static int |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4295 sweep_weak_table (h, remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4296 struct Lisp_Hash_Table *h; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4297 int remove_entries_p; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4298 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4299 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
|
4300 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4301 n = ASIZE (h->index) & ~ARRAY_MARK_FLAG; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4302 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
|
4303 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4304 for (bucket = 0; bucket < n; ++bucket) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4305 { |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4306 Lisp_Object idx, next, prev; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4307 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4308 /* Follow collision chain, removing entries that |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4309 don't survive this garbage collection. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4310 prev = Qnil; |
90970
3371fc48749b
Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
90918
diff
changeset
|
4311 for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4312 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4313 int i = XFASTINT (idx); |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4314 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
|
4315 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
|
4316 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
|
4317 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4318 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
|
4319 remove_p = !key_known_to_survive_p; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4320 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
|
4321 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
|
4322 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
|
4323 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
|
4324 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
|
4325 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
|
4326 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4327 abort (); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4328 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4329 next = HASH_NEXT (h, i); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4330 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4331 if (remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4332 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4333 if (remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4334 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4335 /* Take out of collision chain. */ |
90970
3371fc48749b
Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
90918
diff
changeset
|
4336 if (NILP (prev)) |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4337 HASH_INDEX (h, bucket) = next; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4338 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4339 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
|
4340 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4341 /* Add to free list. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4342 HASH_NEXT (h, i) = h->next_free; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4343 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
|
4344 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4345 /* Clear key, value, and hash. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4346 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4347 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
|
4348 |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4349 h->count--; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4350 } |
59630
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4351 else |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4352 { |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4353 prev = idx; |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4354 } |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4355 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4356 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4357 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4358 if (!remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4359 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4360 /* 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
|
4361 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
|
4362 { |
51768
31f2f6a2df06
(sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51397
diff
changeset
|
4363 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
|
4364 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4365 } |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4366 |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4367 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
|
4368 { |
51768
31f2f6a2df06
(sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51397
diff
changeset
|
4369 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
|
4370 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4371 } |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4372 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4373 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4374 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4375 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4376 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4377 return marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4378 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4379 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4380 /* 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
|
4381 current garbage collection. Remove weak tables that don't survive |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4382 from Vweak_hash_tables. Called from gc_sweep. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4383 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4384 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4385 sweep_weak_hash_tables () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4386 { |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4387 struct Lisp_Hash_Table *h, *used, *next; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4388 int marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4389 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4390 /* 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
|
4391 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
|
4392 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
|
4393 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
|
4394 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
|
4395 one finds that it shouldn't. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4396 do |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4397 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4398 marked = 0; |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4399 for (h = weak_hash_tables; h; h = h->next_weak) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4400 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4401 if (h->size & ARRAY_MARK_FLAG) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4402 marked |= sweep_weak_table (h, 0); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4403 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4404 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4405 while (marked); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4406 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4407 /* Remove tables and entries that aren't used. */ |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4408 for (h = weak_hash_tables, used = NULL; h; h = next) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4409 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4410 next = h->next_weak; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4411 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4412 if (h->size & ARRAY_MARK_FLAG) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4413 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4414 /* TABLE is marked as used. Sweep its contents. */ |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4415 if (h->count > 0) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4416 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
|
4417 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4418 /* 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
|
4419 h->next_weak = used; |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4420 used = h; |
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 } |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4423 |
81813
32d8fd242bb2
* lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81794
diff
changeset
|
4424 weak_hash_tables = used; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4425 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4426 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4427 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4428 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4429 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4430 Hash Code Computation |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4431 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4432 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4433 /* Maximum depth up to which to dive into Lisp structures. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4434 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4435 #define SXHASH_MAX_DEPTH 3 |
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 /* 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
|
4438 account. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4439 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4440 #define SXHASH_MAX_LEN 7 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4441 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4442 /* Combine two integers X and Y for hashing. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4443 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4444 #define SXHASH_COMBINE(X, Y) \ |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
4445 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4446 + (unsigned)(Y)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4447 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4448 |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4449 /* 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
|
4450 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
|
4451 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4452 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4453 sxhash_string (ptr, len) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4454 unsigned char *ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4455 int len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4456 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4457 unsigned char *p = ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4458 unsigned char *end = p + len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4459 unsigned char c; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4460 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4461 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4462 while (p != end) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4463 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4464 c = *p++; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4465 if (c >= 0140) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4466 c -= 40; |
72511
1ef51160f403
(sxhash_string): Rotate properly; don't lose bits.
Richard M. Stallman <rms@gnu.org>
parents:
72136
diff
changeset
|
4467 hash = ((hash << 4) + (hash >> 28) + c); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4468 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4469 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4470 return hash & INTMASK; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4471 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4472 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4473 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4474 /* 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
|
4475 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
|
4476 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4477 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4478 sxhash_list (list, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4479 Lisp_Object list; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4480 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4481 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4482 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4483 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
|
4484 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4485 if (depth < SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4486 for (i = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4487 CONSP (list) && i < SXHASH_MAX_LEN; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4488 list = XCDR (list), ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4489 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4490 unsigned hash2 = sxhash (XCAR (list), depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4491 hash = SXHASH_COMBINE (hash, hash2); |
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 |
69655
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4494 if (!NILP (list)) |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4495 { |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4496 unsigned hash2 = sxhash (list, depth + 1); |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4497 hash = SXHASH_COMBINE (hash, hash2); |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4498 } |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4499 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4500 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4501 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4502 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4503 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4504 /* 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
|
4505 the Lisp structure. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4506 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4507 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4508 sxhash_vector (vec, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4509 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4510 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4511 { |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4512 unsigned hash = ASIZE (vec); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4513 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4514 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4515 n = min (SXHASH_MAX_LEN, ASIZE (vec)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4516 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4517 { |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4518 unsigned hash2 = sxhash (AREF (vec, i), depth + 1); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4519 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4520 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4521 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4522 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4523 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4524 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4525 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4526 /* Return a hash for bool-vector VECTOR. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4527 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4528 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4529 sxhash_bool_vector (vec) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4530 Lisp_Object vec; |
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 unsigned hash = XBOOL_VECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4533 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4534 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4535 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4536 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4537 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4538 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4539 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4540 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4541 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4542 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4543 /* Return 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
|
4544 structure. Value is an unsigned integer clipped to INTMASK. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4545 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4546 unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4547 sxhash (obj, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4548 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4549 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4550 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4551 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4552 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4553 if (depth > SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4554 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
|
4555 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4556 switch (XTYPE (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4557 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4558 case Lisp_Int: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4559 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4560 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4561 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4562 case Lisp_Misc: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4563 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4564 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4565 |
57988
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4566 case Lisp_Symbol: |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4567 obj = SYMBOL_NAME (obj); |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4568 /* Fall through. */ |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4569 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4570 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
|
4571 hash = sxhash_string (SDATA (obj), SCHARS (obj)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4572 break; |
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 /* This can be everything from a vector to an overlay. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4575 case Lisp_Vectorlike: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4576 if (VECTORP (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4577 /* 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
|
4578 they are `eq', except for strings and bit-vectors. In |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4579 Emacs, this works differently. We have to compare element |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4580 by element. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4581 hash = sxhash_vector (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4582 else if (BOOL_VECTOR_P (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4583 hash = sxhash_bool_vector (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4584 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4585 /* 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
|
4586 address as hash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4587 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4588 break; |
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 case Lisp_Cons: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4591 hash = sxhash_list (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4592 break; |
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 case Lisp_Float: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4595 { |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4596 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
|
4597 unsigned char *e = p + sizeof XFLOAT_DATA (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4598 for (hash = 0; p < e; ++p) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4599 hash = SXHASH_COMBINE (hash, *p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4600 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4601 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4602 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4603 default: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4604 abort (); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4605 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4606 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4607 return hash & INTMASK; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4608 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4609 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4610 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4611 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4612 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4613 Lisp Interface |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4614 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4615 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4616 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4617 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
|
4618 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
|
4619 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4620 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4621 { |
77908
e5fb6472b6db
(Fsxhash): Delete stray semicolon.
Chong Yidong <cyd@stupidchicken.com>
parents:
75348
diff
changeset
|
4622 unsigned hash = sxhash (obj, 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4623 return make_number (hash); |
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 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
|
4628 doc: /* Create and return a new hash table. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4629 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4630 Arguments are specified as keyword/argument pairs. The following |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4631 arguments are defined: |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4632 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4633 :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
|
4634 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
|
4635 `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
|
4636 `define-hash-table-test'. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4637 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4638 :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
|
4639 Default is 65. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4640 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4641 :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
|
4642 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
|
4643 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
|
4644 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
|
4645 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4646 :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
|
4647 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
|
4648 table. Default is 0.8. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4649 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4650 :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
|
4651 `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
|
4652 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
|
4653 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
|
4654 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
|
4655 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
|
4656 is nil. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
4657 |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
4658 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
|
4659 (nargs, args) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4660 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4661 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4662 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4663 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4664 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4665 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4666 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4667 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4668 /* 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
|
4669 have been consumed. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4670 used = (char *) alloca (nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4671 bzero (used, nargs * sizeof *used); |
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 /* See if there's a `:test TEST' among the arguments. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4674 i = get_key_arg (QCtest, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4675 test = i < 0 ? Qeql : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4676 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4677 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4678 /* See if it is a user-defined test. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4679 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
|
4680 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4681 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
|
4682 if (!CONSP (prop) || !CONSP (XCDR (prop))) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4683 signal_error ("Invalid hash table test", test); |
40734
95dd892ad5e3
(Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents:
40656
diff
changeset
|
4684 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
|
4685 user_hash = XCAR (XCDR (prop)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4686 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4687 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4688 user_test = user_hash = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4689 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4690 /* See if there's a `:size SIZE' argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4691 i = get_key_arg (QCsize, nargs, args, used); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4692 size = i < 0 ? Qnil : args[i]; |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4693 if (NILP (size)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4694 size = make_number (DEFAULT_HASH_SIZE); |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4695 else if (!INTEGERP (size) || XINT (size) < 0) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4696 signal_error ("Invalid hash table size", size); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4697 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4698 /* Look for `:rehash-size SIZE'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4699 i = get_key_arg (QCrehash_size, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4700 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
|
4701 if (!NUMBERP (rehash_size) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4702 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4703 || XFLOATINT (rehash_size) <= 1.0) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4704 signal_error ("Invalid hash table rehash size", 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
|
4705 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4706 /* Look for `:rehash-threshold THRESHOLD'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4707 i = get_key_arg (QCrehash_threshold, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4708 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
|
4709 if (!FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4710 || XFLOATINT (rehash_threshold) <= 0.0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4711 || XFLOATINT (rehash_threshold) > 1.0) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4712 signal_error ("Invalid hash table rehash threshold", 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
|
4713 |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
4714 /* Look for `:weakness WEAK'. */ |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
4715 i = get_key_arg (QCweakness, nargs, args, used); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4716 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
|
4717 if (EQ (weak, Qt)) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4718 weak = Qkey_and_value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4719 if (!NILP (weak) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4720 && !EQ (weak, Qkey) |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4721 && !EQ (weak, Qvalue) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4722 && !EQ (weak, Qkey_or_value) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4723 && !EQ (weak, Qkey_and_value)) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4724 signal_error ("Invalid hash table weakness", weak); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4725 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4726 /* 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
|
4727 for (i = 0; i < nargs; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4728 if (!used[i]) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4729 signal_error ("Invalid argument list", args[i]); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4730 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4731 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
|
4732 user_test, user_hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4733 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4734 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4735 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4736 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
|
4737 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
|
4738 (table) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4739 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4740 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4741 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
|
4742 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4743 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4744 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4745 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
|
4746 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
|
4747 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4748 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4749 { |
85021
a0c901e4e649
* lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
83648
diff
changeset
|
4750 return make_number (check_hash_table (table)->count); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4751 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4752 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4753 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4754 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4755 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
|
4756 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
|
4757 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4758 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4759 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4760 return check_hash_table (table)->rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4761 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4762 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4763 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4764 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4765 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
|
4766 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
|
4767 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4768 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4769 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4770 return check_hash_table (table)->rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4771 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4772 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4773 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4774 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
|
4775 doc: /* Return the size of TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4776 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
|
4777 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
|
4778 without need for resizing. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4779 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4780 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4781 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4782 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4783 return make_number (HASH_TABLE_SIZE (h)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4784 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4785 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4786 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4787 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
|
4788 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
|
4789 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4790 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4791 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4792 return check_hash_table (table)->test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4793 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4794 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4795 |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4796 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
|
4797 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4798 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
|
4799 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4800 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4801 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4802 return check_hash_table (table)->weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4803 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4804 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4805 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4806 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
|
4807 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
|
4808 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4809 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4810 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4811 return HASH_TABLE_P (obj) ? Qt : Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4812 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4813 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4814 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4815 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, |
87961
868797e785eb
(Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
87903
diff
changeset
|
4816 doc: /* Clear hash table TABLE and return it. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4817 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4818 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4819 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4820 hash_clear (check_hash_table (table)); |
87961
868797e785eb
(Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
87903
diff
changeset
|
4821 /* Be compatible with XEmacs. */ |
868797e785eb
(Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
87903
diff
changeset
|
4822 return table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4823 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4824 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4825 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4826 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
|
4827 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
|
4828 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
|
4829 (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
|
4830 Lisp_Object key, table, dflt; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4831 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4832 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4833 int i = hash_lookup (h, key, NULL); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4834 return i >= 0 ? HASH_VALUE (h, i) : dflt; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4835 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4836 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4837 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4838 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
|
4839 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
|
4840 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
|
4841 VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4842 (key, value, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4843 Lisp_Object key, value, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4844 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4845 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4846 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4847 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4848 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4849 i = hash_lookup (h, key, &hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4850 if (i >= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4851 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4852 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4853 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
|
4854 |
29991
fff5fd809d11
(Fputhash): Return `value' rather than nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29979
diff
changeset
|
4855 return value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4856 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4857 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4858 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4859 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
|
4860 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
|
4861 (key, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4862 Lisp_Object key, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4863 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4864 struct Lisp_Hash_Table *h = check_hash_table (table); |
96815
be932007d518
by renaming, get rid of need for hash_remove() redefinitions for NS platform; also, adjust nsgui dependencies in Makefile
Adrian Robert <Adrian.B.Robert@gmail.com>
parents:
96764
diff
changeset
|
4865 hash_remove_from_table (h, key); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4866 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4867 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4868 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4869 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4870 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
|
4871 doc: /* Call FUNCTION for all entries in hash table TABLE. |
63173
66bf26afd9c6
(Fmemq, Fmaphash): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
62950
diff
changeset
|
4872 FUNCTION is called with two arguments, KEY and VALUE. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4873 (function, table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4874 Lisp_Object function, table; |
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 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4877 Lisp_Object args[3]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4878 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4879 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4880 for (i = 0; i < HASH_TABLE_SIZE (h); ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4881 if (!NILP (HASH_HASH (h, i))) |
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 args[0] = function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4884 args[1] = HASH_KEY (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4885 args[2] = HASH_VALUE (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4886 Ffuncall (3, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4887 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4888 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4889 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4890 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4891 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4892 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4893 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4894 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
|
4895 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
|
4896 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4897 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
|
4898 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
|
4899 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4900 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
|
4901 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
|
4902 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
|
4903 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
|
4904 including negative integers. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4905 (name, test, hash) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4906 Lisp_Object name, test, hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4907 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4908 return Fput (name, Qhash_table_test, list2 (test, hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4909 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4910 |
28965 | 4911 |
34050 | 4912 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4913 /************************************************************************ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4914 MD5 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4915 ************************************************************************/ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4916 |
34050 | 4917 #include "md5.h" |
4918 | |
4919 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
|
4920 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
|
4921 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4922 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
|
4923 algorithm to calculate it is defined in RFC 1321. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4924 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4925 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
|
4926 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
|
4927 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
|
4928 OBJECT. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4929 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4930 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
|
4931 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
|
4932 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
|
4933 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
|
4934 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
|
4935 file. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4936 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4937 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
|
4938 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
|
4939 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
|
4940 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4941 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
|
4942 command `prefer-coding-system') is used. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4943 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4944 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
|
4945 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
|
4946 (object, start, end, coding_system, noerror) |
34050 | 4947 Lisp_Object object, start, end, coding_system, noerror; |
4948 { | |
4949 unsigned char digest[16]; | |
4950 unsigned char value[33]; | |
4951 int i; | |
4952 int size; | |
4953 int size_byte = 0; | |
4954 int start_char = 0, end_char = 0; | |
4955 int start_byte = 0, end_byte = 0; | |
4956 register int b, e; | |
4957 register struct buffer *bp; | |
4958 int temp; | |
4959 | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4960 if (STRINGP (object)) |
34050 | 4961 { |
4962 if (NILP (coding_system)) | |
4963 { | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4964 /* 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
|
4965 |
34050 | 4966 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
|
4967 /* use default, we can't guess correct value */ |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
4968 coding_system = preferred_coding_system (); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4969 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4970 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4971 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4972 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4973 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
|
4974 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4975 /* Invalid coding system. */ |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4976 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4977 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4978 coding_system = Qraw_text; |
34050 | 4979 else |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4980 xsignal1 (Qcoding_system_error, coding_system); |
34050 | 4981 } |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4982 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4983 if (STRING_MULTIBYTE (object)) |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
4984 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); |
34050 | 4985 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4986 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
|
4987 size_byte = SBYTES (object); |
34050 | 4988 |
4989 if (!NILP (start)) | |
4990 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
4991 CHECK_NUMBER (start); |
34050 | 4992 |
4993 start_char = XINT (start); | |
4994 | |
4995 if (start_char < 0) | |
4996 start_char += size; | |
4997 | |
4998 start_byte = string_char_to_byte (object, start_char); | |
4999 } | |
5000 | |
5001 if (NILP (end)) | |
5002 { | |
5003 end_char = size; | |
5004 end_byte = size_byte; | |
5005 } | |
5006 else | |
5007 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5008 CHECK_NUMBER (end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5009 |
34050 | 5010 end_char = XINT (end); |
5011 | |
5012 if (end_char < 0) | |
5013 end_char += size; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5014 |
34050 | 5015 end_byte = string_char_to_byte (object, end_char); |
5016 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5017 |
34050 | 5018 if (!(0 <= start_char && start_char <= end_char && end_char <= size)) |
5019 args_out_of_range_3 (object, make_number (start_char), | |
5020 make_number (end_char)); | |
5021 } | |
5022 else | |
5023 { | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5024 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
|
5025 |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5026 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
|
5027 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5028 CHECK_BUFFER (object); |
34050 | 5029 |
5030 bp = XBUFFER (object); | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5031 if (bp != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5032 set_buffer_internal (bp); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5033 |
34050 | 5034 if (NILP (start)) |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5035 b = BEGV; |
34050 | 5036 else |
5037 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5038 CHECK_NUMBER_COERCE_MARKER (start); |
34050 | 5039 b = XINT (start); |
5040 } | |
5041 | |
5042 if (NILP (end)) | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5043 e = ZV; |
34050 | 5044 else |
5045 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5046 CHECK_NUMBER_COERCE_MARKER (end); |
34050 | 5047 e = XINT (end); |
5048 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5049 |
34050 | 5050 if (b > e) |
5051 temp = b, b = e, e = temp; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5052 |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5053 if (!(BEGV <= b && e <= ZV)) |
34050 | 5054 args_out_of_range (start, end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5055 |
34050 | 5056 if (NILP (coding_system)) |
5057 { | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5058 /* 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
|
5059 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
|
5060 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5061 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
|
5062 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
|
5063 else |
34050 | 5064 { |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5065 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
|
5066 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5067 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
|
5068 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5069 || 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
|
5070 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5071 coding_system = Qnil; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5072 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
|
5073 force_raw_text = 1; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5074 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5075 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5076 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
|
5077 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5078 /* 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
|
5079 Lisp_Object args[4], val; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5080 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5081 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
|
5082 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
|
5083 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
|
5084 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
|
5085 coding_system = XCDR (val); |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5086 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5087 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5088 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5089 && !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
|
5090 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5091 /* 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
|
5092 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
|
5093 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
|
5094 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5095 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5096 if (!force_raw_text |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5097 && !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
|
5098 /* 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
|
5099 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
|
5100 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
|
5101 coding_system, Qnil); |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5102 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5103 if (force_raw_text) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5104 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5105 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5106 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5107 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
|
5108 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5109 /* Invalid coding system. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5110 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5111 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5112 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5113 else |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
5114 xsignal1 (Qcoding_system_error, coding_system); |
34050 | 5115 } |
5116 } | |
5117 | |
5118 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
|
5119 if (prev != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5120 set_buffer_internal (prev); |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5121 /* 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
|
5122 buffer. */ |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5123 specpdl_ptr--; |
34050 | 5124 |
5125 if (STRING_MULTIBYTE (object)) | |
89483 | 5126 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); |
34050 | 5127 } |
5128 | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5129 md5_buffer (SDATA (object) + start_byte, |
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5130 SBYTES (object) - (size_byte - end_byte), |
34050 | 5131 digest); |
5132 | |
5133 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
|
5134 sprintf (&value[2 * i], "%02x", digest[i]); |
34050 | 5135 value[32] = '\0'; |
5136 | |
5137 return make_string (value, 32); | |
5138 } | |
5139 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5140 |
21514 | 5141 void |
211 | 5142 syms_of_fns () |
5143 { | |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5144 /* Hash table stuff. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5145 Qhash_table_p = intern ("hash-table-p"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5146 staticpro (&Qhash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5147 Qeq = intern ("eq"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5148 staticpro (&Qeq); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5149 Qeql = intern ("eql"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5150 staticpro (&Qeql); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5151 Qequal = intern ("equal"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5152 staticpro (&Qequal); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5153 QCtest = intern (":test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5154 staticpro (&QCtest); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5155 QCsize = intern (":size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5156 staticpro (&QCsize); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5157 QCrehash_size = intern (":rehash-size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5158 staticpro (&QCrehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5159 QCrehash_threshold = intern (":rehash-threshold"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5160 staticpro (&QCrehash_threshold); |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5161 QCweakness = intern (":weakness"); |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5162 staticpro (&QCweakness); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5163 Qkey = intern ("key"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5164 staticpro (&Qkey); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5165 Qvalue = intern ("value"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5166 staticpro (&Qvalue); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5167 Qhash_table_test = intern ("hash-table-test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5168 staticpro (&Qhash_table_test); |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5169 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
|
5170 staticpro (&Qkey_or_value); |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5171 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
|
5172 staticpro (&Qkey_and_value); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5173 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5174 defsubr (&Ssxhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5175 defsubr (&Smake_hash_table); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5176 defsubr (&Scopy_hash_table); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5177 defsubr (&Shash_table_count); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5178 defsubr (&Shash_table_rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5179 defsubr (&Shash_table_rehash_threshold); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5180 defsubr (&Shash_table_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5181 defsubr (&Shash_table_test); |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5182 defsubr (&Shash_table_weakness); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5183 defsubr (&Shash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5184 defsubr (&Sclrhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5185 defsubr (&Sgethash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5186 defsubr (&Sputhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5187 defsubr (&Sremhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5188 defsubr (&Smaphash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5189 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
|
5190 |
211 | 5191 Qstring_lessp = intern ("string-lessp"); |
5192 staticpro (&Qstring_lessp); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5193 Qprovide = intern ("provide"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5194 staticpro (&Qprovide); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5195 Qrequire = intern ("require"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5196 staticpro (&Qrequire); |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
5197 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
|
5198 staticpro (&Qyes_or_no_p_history); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
5199 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
|
5200 staticpro (&Qcursor_in_echo_area); |
20004 | 5201 Qwidget_type = intern ("widget-type"); |
5202 staticpro (&Qwidget_type); | |
211 | 5203 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5204 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
|
5205 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
|
5206 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5207 require_nesting_list = Qnil; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5208 staticpro (&require_nesting_list); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5209 |
14486
3c4ba112108e
(syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents:
14456
diff
changeset
|
5210 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
|
5211 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5212 DEFVAR_LISP ("features", &Vfeatures, |
73686
d2a970fd4273
(Ffeaturep, syms_of_fns): Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
73049
diff
changeset
|
5213 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
|
5214 Used by `featurep' and `require', and altered by `provide'. */); |
64774
369c84bf493f
(syms_of_fns): Add `emacs' to features.
Richard M. Stallman <rms@gnu.org>
parents:
64770
diff
changeset
|
5215 Vfeatures = Fcons (intern ("emacs"), Qnil); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5216 Qsubfeatures = intern ("subfeatures"); |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5217 staticpro (&Qsubfeatures); |
211 | 5218 |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5219 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5220 Qcodeset = intern ("codeset"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5221 staticpro (&Qcodeset); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5222 Qdays = intern ("days"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5223 staticpro (&Qdays); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5224 Qmonths = intern ("months"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5225 staticpro (&Qmonths); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5226 Qpaper = intern ("paper"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5227 staticpro (&Qpaper); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5228 #endif /* HAVE_LANGINFO_CODESET */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5229 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5230 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
|
5231 doc: /* *Non-nil means mouse commands use dialog boxes to ask questions. |
44712 | 5232 This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands |
97454
68a4bf203661
(use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
97043
diff
changeset
|
5233 invoked by mouse clicks and mouse menu items. |
68a4bf203661
(use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
97043
diff
changeset
|
5234 |
68a4bf203661
(use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
97043
diff
changeset
|
5235 On some platforms, file selection dialogs are also enabled if this is |
68a4bf203661
(use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
97043
diff
changeset
|
5236 non-nil. */); |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
5237 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
|
5238 |
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
|
5239 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
|
5240 doc: /* *Non-nil means mouse commands use a file dialog to ask for files. |
79868
9538ce91bacf
(use_file_dialog): Doc fix.
Jason Rumney <jasonr@gnu.org>
parents:
79759
diff
changeset
|
5241 This applies to commands from menus and tool bar buttons even when |
9538ce91bacf
(use_file_dialog): Doc fix.
Jason Rumney <jasonr@gnu.org>
parents:
79759
diff
changeset
|
5242 they are initiated from the keyboard. The value of `use-dialog-box' |
9538ce91bacf
(use_file_dialog): Doc fix.
Jason Rumney <jasonr@gnu.org>
parents:
79759
diff
changeset
|
5243 takes precedence over this variable, so a file dialog is only used if |
9538ce91bacf
(use_file_dialog): Doc fix.
Jason Rumney <jasonr@gnu.org>
parents:
79759
diff
changeset
|
5244 both `use-dialog-box' and this variable are non-nil. */); |
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
|
5245 use_file_dialog = 1; |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
5246 |
211 | 5247 defsubr (&Sidentity); |
5248 defsubr (&Srandom); | |
5249 defsubr (&Slength); | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
5250 defsubr (&Ssafe_length); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
5251 defsubr (&Sstring_bytes); |
211 | 5252 defsubr (&Sstring_equal); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
5253 defsubr (&Scompare_strings); |
211 | 5254 defsubr (&Sstring_lessp); |
5255 defsubr (&Sappend); | |
5256 defsubr (&Sconcat); | |
5257 defsubr (&Svconcat); | |
5258 defsubr (&Scopy_sequence); | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5259 defsubr (&Sstring_make_multibyte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5260 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
|
5261 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
|
5262 defsubr (&Sstring_as_unibyte); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
5263 defsubr (&Sstring_to_multibyte); |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
5264 defsubr (&Sstring_to_unibyte); |
211 | 5265 defsubr (&Scopy_alist); |
5266 defsubr (&Ssubstring); | |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5267 defsubr (&Ssubstring_no_properties); |
211 | 5268 defsubr (&Snthcdr); |
5269 defsubr (&Snth); | |
5270 defsubr (&Selt); | |
5271 defsubr (&Smember); | |
5272 defsubr (&Smemq); | |
73029 | 5273 defsubr (&Smemql); |
211 | 5274 defsubr (&Sassq); |
5275 defsubr (&Sassoc); | |
5276 defsubr (&Srassq); | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
5277 defsubr (&Srassoc); |
211 | 5278 defsubr (&Sdelq); |
414 | 5279 defsubr (&Sdelete); |
211 | 5280 defsubr (&Snreverse); |
5281 defsubr (&Sreverse); | |
5282 defsubr (&Ssort); | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5283 defsubr (&Splist_get); |
211 | 5284 defsubr (&Sget); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5285 defsubr (&Splist_put); |
211 | 5286 defsubr (&Sput); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5287 defsubr (&Slax_plist_get); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5288 defsubr (&Slax_plist_put); |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
5289 defsubr (&Seql); |
211 | 5290 defsubr (&Sequal); |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
5291 defsubr (&Sequal_including_properties); |
211 | 5292 defsubr (&Sfillarray); |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
5293 defsubr (&Sclear_string); |
211 | 5294 defsubr (&Snconc); |
5295 defsubr (&Smapcar); | |
28666 | 5296 defsubr (&Smapc); |
211 | 5297 defsubr (&Smapconcat); |
5298 defsubr (&Sy_or_n_p); | |
5299 defsubr (&Syes_or_no_p); | |
5300 defsubr (&Sload_average); | |
5301 defsubr (&Sfeaturep); | |
5302 defsubr (&Srequire); | |
5303 defsubr (&Sprovide); | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
5304 defsubr (&Splist_member); |
20004 | 5305 defsubr (&Swidget_put); |
5306 defsubr (&Swidget_get); | |
5307 defsubr (&Swidget_apply); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5308 defsubr (&Sbase64_encode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5309 defsubr (&Sbase64_decode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5310 defsubr (&Sbase64_encode_string); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5311 defsubr (&Sbase64_decode_string); |
34050 | 5312 defsubr (&Smd5); |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
5313 defsubr (&Slocale_info); |
211 | 5314 } |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5317 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5318 init_fns () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5319 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5320 } |
52401 | 5321 |
5322 /* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31 | |
5323 (do not change this comment) */ |