Mercurial > emacs
annotate src/fns.c @ 96294:f12e581d977f
(completion-basic-try-completion): Use the text after
point to consrain the completion candidates.
(completion-basic-all-completions): Adjust accordingly.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 26 Jun 2008 02:48:56 +0000 |
parents | 0073930415c3 |
children | ff7196ae78c9 |
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 |
59146
9bde7721ad0f
* dispextern.h: Change HAVE_CARBON to MAC_OS.
Steven Tamm <steventamm@mac.com>
parents:
58623
diff
changeset
|
28 #ifndef MAC_OS |
9bde7721ad0f
* dispextern.h: Change HAVE_CARBON to MAC_OS.
Steven Tamm <steventamm@mac.com>
parents:
58623
diff
changeset
|
29 /* On Mac OS, defining this conflicts with precompiled headers. */ |
50301
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
30 |
211 | 31 /* Note on some machines this defines `vector' as a typedef, |
32 so make sure we don't use that name in this file. */ | |
33 #undef vector | |
34 #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
|
35 |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
36 #endif /* ! MAC_OSX */ |
c0f3ec529c05
Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents:
49915
diff
changeset
|
37 |
211 | 38 #include "lisp.h" |
39 #include "commands.h" | |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
40 #include "character.h" |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
41 #include "coding.h" |
211 | 42 #include "buffer.h" |
1513
7381accd610d
* fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1194
diff
changeset
|
43 #include "keyboard.h" |
39697
0b986bb45526
Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39682
diff
changeset
|
44 #include "keymap.h" |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
45 #include "intervals.h" |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
46 #include "frame.h" |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
47 #include "window.h" |
37319 | 48 #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
|
49 #ifdef HAVE_MENUS |
0a13b0324d7a
[HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
69655
diff
changeset
|
50 #if defined (HAVE_X_WINDOWS) |
21514 | 51 #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
|
52 #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
|
53 #include "macterm.h" |
0a13b0324d7a
[HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents:
69655
diff
changeset
|
54 #endif |
21514 | 55 #endif |
211 | 56 |
12062 | 57 #ifndef NULL |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
58 #define NULL ((POINTER_TYPE *)0) |
12062 | 59 #endif |
60 | |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
61 /* 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
|
62 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
|
63 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
|
64 |
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
|
65 /* 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
|
66 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
|
67 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
|
68 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
69 extern int minibuffer_auto_raise; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
70 extern Lisp_Object minibuf_window; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
71 extern Lisp_Object Vlocale_coding_system; |
61622
aef105b11011
(Vloads_in_progress): Remove extern.
Lute Kamstra <lute@gnu.org>
parents:
61433
diff
changeset
|
72 extern int load_in_progress; |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
73 |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
74 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
|
75 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
|
76 Lisp_Object Qcursor_in_echo_area; |
20004 | 77 Lisp_Object Qwidget_type; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
78 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; |
211 | 79 |
23051
18ed8d6b11e5
(Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents:
22853
diff
changeset
|
80 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
|
81 |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
82 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
|
83 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
84 extern long get_random (); |
65713
ad24f42046b1
* xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
65325
diff
changeset
|
85 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
|
86 |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
87 #ifndef HAVE_UNISTD_H |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
88 extern long time (); |
061d5d4f7967
(time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents:
21577
diff
changeset
|
89 #endif |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
90 |
211 | 91 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
41006 | 92 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
|
93 (arg) |
211 | 94 Lisp_Object arg; |
95 { | |
96 return arg; | |
97 } | |
98 | |
99 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
|
100 doc: /* Return a pseudo-random number. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
101 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
|
102 On most systems, this is 29 bits' worth. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
103 With positive integer argument N, return random number in interval [0,N). |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
104 With argument t, set the random number seed from the current time and pid. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
105 (n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
106 Lisp_Object n; |
211 | 107 { |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
108 EMACS_INT val; |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
109 Lisp_Object lispy_val; |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
110 unsigned long denominator; |
211 | 111 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
112 if (EQ (n, Qt)) |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
113 seed_random (getpid () + time (NULL)); |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
114 if (NATNUMP (n) && XFASTINT (n) != 0) |
211 | 115 { |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
116 /* 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
|
117 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
|
118 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
|
119 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
|
120 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
|
121 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
|
122 when using a large n. */ |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
123 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
124 do |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
125 val = get_random () / denominator; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
126 while (val >= XFASTINT (n)); |
211 | 127 } |
6376
3fe339cf2dde
(Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents:
6344
diff
changeset
|
128 else |
10485
40c59e55775a
(Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents:
10411
diff
changeset
|
129 val = get_random (); |
12008
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
130 XSETINT (lispy_val, val); |
637671248a31
(Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents:
11539
diff
changeset
|
131 return lispy_val; |
211 | 132 } |
133 | |
134 /* Random data-structure functions */ | |
135 | |
136 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
|
137 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
|
138 A byte-code function object is also allowed. |
47762 | 139 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
|
140 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
|
141 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
|
142 (sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
143 register Lisp_Object sequence; |
211 | 144 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
145 register Lisp_Object val; |
211 | 146 register int i; |
147 | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
148 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
|
149 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
|
150 else if (VECTORP (sequence)) |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
151 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
|
152 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
|
153 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
|
154 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
|
155 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
|
156 else if (COMPILEDP (sequence)) |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
157 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
|
158 else if (CONSP (sequence)) |
211 | 159 { |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
160 i = 0; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
161 while (CONSP (sequence)) |
211 | 162 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
163 sequence = XCDR (sequence); |
26256
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
164 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
165 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
166 if (!CONSP (sequence)) |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
167 break; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
168 |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
169 sequence = XCDR (sequence); |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
170 ++i; |
144cf26f35e1
(Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents:
26230
diff
changeset
|
171 QUIT; |
211 | 172 } |
173 | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
174 CHECK_LIST_END (sequence, sequence); |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
175 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
176 val = make_number (i); |
211 | 177 } |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
178 else if (NILP (sequence)) |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
179 XSETFASTINT (val, 0); |
211 | 180 else |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
181 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
|
182 |
9965
f68eab303ddb
(Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents:
9927
diff
changeset
|
183 return val; |
211 | 184 } |
185 | |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
186 /* 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
|
187 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
188 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
|
189 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
|
190 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
|
191 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
|
192 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
|
193 (list) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
194 Lisp_Object list; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
195 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
196 Lisp_Object tail, halftail, length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
197 int len = 0; |
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 /* halftail is used to detect circular lists. */ |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
200 halftail = list; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
201 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
202 { |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
203 if (EQ (tail, halftail) && len != 0) |
12618
60c4c0fee545
(Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents:
12466
diff
changeset
|
204 break; |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
205 len++; |
13344
30e17254a280
(Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents:
13277
diff
changeset
|
206 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
|
207 halftail = XCDR (halftail); |
12466
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 |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
210 XSETINT (length, len); |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
211 return length; |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
212 } |
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
213 |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
214 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
|
215 doc: /* Return the number of bytes in STRING. |
90667 | 216 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
|
217 (string) |
20881
fd35cf0efd94
(Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents:
20880
diff
changeset
|
218 Lisp_Object string; |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
219 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
220 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
|
221 return make_number (SBYTES (string)); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
222 } |
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
223 |
211 | 224 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
|
225 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
|
226 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
|
227 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
|
228 (s1, s2) |
211 | 229 register Lisp_Object s1, s2; |
230 { | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
231 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
232 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
|
233 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
234 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
|
235 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
236 CHECK_STRING (s2); |
211 | 237 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
238 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
|
239 || 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
|
240 || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1))) |
211 | 241 return Qnil; |
242 return Qt; | |
243 } | |
244 | |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
245 DEFUN ("compare-strings", Fcompare_strings, |
21673
8a32bf93da04
(Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents:
21671
diff
changeset
|
246 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
|
247 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
|
248 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
|
249 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
|
250 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
|
251 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
252 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
|
253 Unibyte strings are converted to multibyte for comparison. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
254 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
255 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
|
256 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
|
257 - 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
|
258 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
|
259 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
|
260 (str1, start1, end1, str2, start2, end2, ignore_case) |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
261 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
|
262 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
263 register int end1_char, end2_char; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
264 register int i1, i1_byte, i2, i2_byte; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
265 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
266 CHECK_STRING (str1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
267 CHECK_STRING (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
268 if (NILP (start1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
269 start1 = make_number (0); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
270 if (NILP (start2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
271 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
|
272 CHECK_NATNUM (start1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
273 CHECK_NATNUM (start2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
274 if (! NILP (end1)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
275 CHECK_NATNUM (end1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
276 if (! NILP (end2)) |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
277 CHECK_NATNUM (end2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
278 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
279 i1 = XINT (start1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
280 i2 = XINT (start2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
281 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
282 i1_byte = string_char_to_byte (str1, i1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
283 i2_byte = string_char_to_byte (str2, i2); |
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 end1_char = SCHARS (str1); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
286 if (! NILP (end1) && end1_char > XINT (end1)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
287 end1_char = XINT (end1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
288 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
289 end2_char = SCHARS (str2); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
290 if (! NILP (end2) && end2_char > XINT (end2)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
291 end2_char = XINT (end2); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
292 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
293 while (i1 < end1_char && i2 < end2_char) |
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 /* When we find a mismatch, we must compare the |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
296 characters, not just the bytes. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
297 int c1, c2; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
298 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
299 if (STRING_MULTIBYTE (str1)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
300 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
|
301 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
302 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
303 c1 = SREF (str1, i1++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
304 c1 = unibyte_char_to_multibyte (c1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
305 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
306 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
307 if (STRING_MULTIBYTE (str2)) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
308 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
|
309 else |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
310 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
311 c2 = SREF (str2, i2++); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
312 c2 = unibyte_char_to_multibyte (c2); |
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 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
315 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
316 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
317 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
318 if (! NILP (ignore_case)) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
319 { |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
320 Lisp_Object tem; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
321 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
322 tem = Fupcase (make_number (c1)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
323 c1 = XINT (tem); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
324 tem = Fupcase (make_number (c2)); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
325 c2 = XINT (tem); |
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 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
328 if (c1 == c2) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
329 continue; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
330 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
331 /* Note that I1 has already been incremented |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
332 past the character that we are comparing; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
333 hence we don't add or subtract 1 here. */ |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
334 if (c1 < c2) |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
335 return make_number (- i1 + XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
336 else |
37309
aecc289cb0de
(Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents:
37279
diff
changeset
|
337 return make_number (i1 - XINT (start1)); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
338 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
339 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
340 if (i1 < end1_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
341 return make_number (i1 - XINT (start1) + 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
342 if (i2 < end2_char) |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
343 return make_number (- i1 + XINT (start1) - 1); |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
344 |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
345 return Qt; |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
346 } |
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
347 |
211 | 348 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
|
349 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
|
350 Case is significant. |
73926
21f6be2e8ecb
(Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents:
73686
diff
changeset
|
351 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
|
352 (s1, s2) |
211 | 353 register Lisp_Object s1, s2; |
354 { | |
355 register int end; | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
356 register int i1, i1_byte, i2, i2_byte; |
211 | 357 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
358 if (SYMBOLP (s1)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
359 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
|
360 if (SYMBOLP (s2)) |
45401
317e23417505
* fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents:
45039
diff
changeset
|
361 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
|
362 CHECK_STRING (s1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
363 CHECK_STRING (s2); |
211 | 364 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
365 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
|
366 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
367 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
|
368 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
|
369 end = SCHARS (s2); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
370 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
371 while (i1 < end) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
372 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
373 /* 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
|
374 characters, not just the bytes. */ |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
375 int c1, c2; |
211 | 376 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
377 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
|
378 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
|
379 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
380 if (c1 != c2) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
381 return c1 < c2 ? Qt : Qnil; |
211 | 382 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
383 return i1 < SCHARS (s2) ? Qt : Qnil; |
211 | 384 } |
385 | |
72609
f396703cc830
(concat) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
parents:
72511
diff
changeset
|
386 #if __GNUC__ |
f396703cc830
(concat) [__GNUC__]: Declare with `__attribute__((noinline))'.
Eli Zaretskii <eliz@gnu.org>
parents:
72511
diff
changeset
|
387 /* "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
|
388 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
|
389 expects these values on the stack. */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
390 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
|
391 #else /* !__GNUC__ */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
392 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
|
393 #endif |
211 | 394 |
395 /* ARGSUSED */ | |
396 Lisp_Object | |
397 concat2 (s1, s2) | |
398 Lisp_Object s1, s2; | |
399 { | |
400 #ifdef NO_ARG_ARRAY | |
401 Lisp_Object args[2]; | |
402 args[0] = s1; | |
403 args[1] = s2; | |
404 return concat (2, args, Lisp_String, 0); | |
405 #else | |
406 return concat (2, &s1, Lisp_String, 0); | |
407 #endif /* NO_ARG_ARRAY */ | |
408 } | |
409 | |
8966
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
410 /* ARGSUSED */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
411 Lisp_Object |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
412 concat3 (s1, s2, s3) |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
413 Lisp_Object s1, s2, s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
414 { |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
415 #ifdef NO_ARG_ARRAY |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
416 Lisp_Object args[3]; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
417 args[0] = s1; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
418 args[1] = s2; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
419 args[2] = s3; |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
420 return concat (3, args, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
421 #else |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
422 return concat (3, &s1, Lisp_String, 0); |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
423 #endif /* NO_ARG_ARRAY */ |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
424 } |
cafc16f356c2
(concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents:
8901
diff
changeset
|
425 |
211 | 426 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
|
427 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
|
428 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
|
429 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
|
430 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
|
431 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
|
432 (nargs, args) |
211 | 433 int nargs; |
434 Lisp_Object *args; | |
435 { | |
436 return concat (nargs, args, Lisp_Cons, 1); | |
437 } | |
438 | |
439 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
|
440 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
|
441 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
|
442 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
|
443 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
|
444 (nargs, args) |
211 | 445 int nargs; |
446 Lisp_Object *args; | |
447 { | |
448 return concat (nargs, args, Lisp_String, 0); | |
449 } | |
450 | |
451 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
|
452 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
|
453 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
|
454 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
|
455 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
|
456 (nargs, args) |
211 | 457 int nargs; |
458 Lisp_Object *args; | |
459 { | |
10006
402c87cbc4fa
(Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9965
diff
changeset
|
460 return concat (nargs, args, Lisp_Vectorlike, 0); |
211 | 461 } |
462 | |
17318
224e100b393c
(copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents:
17291
diff
changeset
|
463 |
211 | 464 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, |
48320 | 465 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
|
466 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
|
467 with the original. */) |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
468 (arg) |
211 | 469 Lisp_Object arg; |
470 { | |
485 | 471 if (NILP (arg)) return 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 if (CHAR_TABLE_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
474 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
475 return copy_char_table (arg); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
476 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
477 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
478 if (BOOL_VECTOR_P (arg)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
479 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
480 Lisp_Object val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
481 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
482 = ((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
|
483 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
484 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
485 val = Fmake_bool_vector (Flength (arg), Qnil); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
486 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
|
487 size_in_chars); |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
488 return val; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
489 } |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
490 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
491 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
|
492 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
|
493 |
211 | 494 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); |
495 } | |
496 | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
497 /* 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
|
498 a string and has text properties to be copied. */ |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
499 struct textprop_rec |
25093
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 int argnum; /* refer to ARGS (arguments of `concat') */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
502 int from; /* refer to ARGS[argnum] (argument string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
503 int to; /* refer to VAL (the target string) */ |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
504 }; |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
505 |
211 | 506 static Lisp_Object |
507 concat (nargs, args, target_type, last_special) | |
508 int nargs; | |
509 Lisp_Object *args; | |
510 enum Lisp_Type target_type; | |
511 int last_special; | |
512 { | |
513 Lisp_Object val; | |
514 register Lisp_Object tail; | |
515 register Lisp_Object this; | |
516 int toindex; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
517 int toindex_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
518 register int result_len; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
519 register int result_len_byte; |
211 | 520 register int argnum; |
521 Lisp_Object last_tail; | |
522 Lisp_Object prev; | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
523 int some_multibyte; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
524 /* 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
|
525 while concatinating each string because the length of resulting |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
526 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
|
527 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
|
528 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
|
529 struct textprop_rec *textprops = NULL; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
530 /* Number of elments in textprops. */ |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
531 int num_textprops = 0; |
58623 | 532 USE_SAFE_ALLOCA; |
211 | 533 |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
534 tail = Qnil; |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
535 |
211 | 536 /* In append, the last arg isn't treated like the others */ |
537 if (last_special && nargs > 0) | |
538 { | |
539 nargs--; | |
540 last_tail = args[nargs]; | |
541 } | |
542 else | |
543 last_tail = Qnil; | |
544 | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
545 /* Check each argument. */ |
211 | 546 for (argnum = 0; argnum < nargs; argnum++) |
547 { | |
548 this = args[argnum]; | |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
549 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
|
550 || 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
|
551 wrong_type_argument (Qsequencep, this); |
211 | 552 } |
553 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
554 /* 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
|
555 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
|
556 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
|
557 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
|
558 result_len_byte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
559 result_len = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
560 some_multibyte = 0; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
561 for (argnum = 0; argnum < nargs; argnum++) |
211 | 562 { |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
563 int len; |
211 | 564 this = args[argnum]; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
565 len = XFASTINT (Flength (this)); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
566 if (target_type == Lisp_String) |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
567 { |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
568 /* 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
|
569 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
|
570 int i; |
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
571 Lisp_Object ch; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
572 int this_len_byte; |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
573 |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
574 if (VECTORP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
575 for (i = 0; i < len; i++) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
576 { |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
577 ch = AREF (this, i); |
90533 | 578 CHECK_CHARACTER (ch); |
23128
45de23c16505
(concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents:
23057
diff
changeset
|
579 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
|
580 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
|
581 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
|
582 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
583 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
584 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
|
585 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
|
586 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
|
587 for (; CONSP (this); this = XCDR (this)) |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
588 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
589 ch = XCAR (this); |
90533 | 590 CHECK_CHARACTER (ch); |
23128
45de23c16505
(concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents:
23057
diff
changeset
|
591 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
|
592 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
|
593 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
|
594 some_multibyte = 1; |
19278
50f47ef6ce9a
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
19223
diff
changeset
|
595 } |
20639
12240a9b3679
(concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents:
20607
diff
changeset
|
596 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
597 { |
20699
907d8633c8cc
(concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents:
20667
diff
changeset
|
598 if (STRING_MULTIBYTE (this)) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
599 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
600 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
|
601 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
|
602 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
603 else |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
604 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
|
605 SCHARS (this)); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
606 } |
18311
8b716cb12cdd
(concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents:
18108
diff
changeset
|
607 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
608 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
609 result_len += len; |
211 | 610 } |
611 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
612 if (! some_multibyte) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
613 result_len_byte = result_len; |
211 | 614 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
615 /* Create the output object. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
616 if (target_type == Lisp_Cons) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
617 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
|
618 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
|
619 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
|
620 else if (some_multibyte) |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
621 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
|
622 else |
21260
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
623 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
|
624 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
625 /* 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
|
626 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
|
627 return last_tail; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
628 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
629 /* Copy the contents of the args into the result. */ |
211 | 630 if (CONSP (val)) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
631 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ |
211 | 632 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
633 toindex = 0, toindex_byte = 0; |
211 | 634 |
635 prev = Qnil; | |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
636 if (STRINGP (val)) |
58623 | 637 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
|
638 |
211 | 639 for (argnum = 0; argnum < nargs; argnum++) |
640 { | |
641 Lisp_Object thislen; | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
642 int thisleni = 0; |
16863
591b7a95d7a5
(concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents:
16561
diff
changeset
|
643 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
|
644 register unsigned int thisindex_byte = 0; |
211 | 645 |
646 this = args[argnum]; | |
647 if (!CONSP (this)) | |
648 thislen = Flength (this), thisleni = XINT (thislen); | |
649 | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
650 /* 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
|
651 if (STRINGP (this) && STRINGP (val) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
652 && 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
|
653 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
654 int thislen_byte = SBYTES (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
655 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
656 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
|
657 SBYTES (this)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
658 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
659 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
660 textprops[num_textprops].argnum = argnum; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
661 textprops[num_textprops].from = 0; |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
662 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
663 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
664 toindex_byte += thislen_byte; |
55481
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
665 toindex += thisleni; |
53ac9afa3d0a
(count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents:
55161
diff
changeset
|
666 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
|
667 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
668 /* 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
|
669 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
|
670 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
671 if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
672 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
673 textprops[num_textprops].argnum = argnum; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
674 textprops[num_textprops].from = 0; |
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
675 textprops[num_textprops++].to = toindex; |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
676 } |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
677 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
|
678 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
|
679 SCHARS (this), 0, 1); |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
680 toindex += thisleni; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
681 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
682 else |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
683 /* Copy element by element. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
684 while (1) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
685 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
686 register Lisp_Object elt; |
211 | 687 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
688 /* 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
|
689 `this' is exhausted. */ |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
690 if (NILP (this)) break; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
691 if (CONSP (this)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
692 elt = XCAR (this), this = XCDR (this); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
693 else if (thisindex >= thisleni) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
694 break; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
695 else if (STRINGP (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
696 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
697 int c; |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
698 if (STRING_MULTIBYTE (this)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
699 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
700 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
701 thisindex, |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
702 thisindex_byte); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
703 XSETFASTINT (elt, c); |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
704 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
705 else |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
706 { |
58265
491080266027
Avoid side-effects inside XSETFASTINT's arguments.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58239
diff
changeset
|
707 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
|
708 if (some_multibyte |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
709 && XINT (elt) >= 0200 |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
710 && XINT (elt) < 0400) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
711 { |
21029
3f47b0364c2a
(DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents:
21021
diff
changeset
|
712 c = unibyte_char_to_multibyte (XINT (elt)); |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
713 XSETINT (elt, c); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
714 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
715 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
716 } |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
717 else if (BOOL_VECTOR_P (this)) |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
718 { |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
719 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
720 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
|
721 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
|
722 elt = Qt; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
723 else |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
724 elt = Qnil; |
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
725 thisindex++; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
726 } |
20814
8f6d92b4f48a
(concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20813
diff
changeset
|
727 else |
91667
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
728 { |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
729 elt = AREF (this, thisindex); |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
730 thisindex++; |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
731 } |
211 | 732 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
733 /* 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
|
734 if (toindex < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
735 { |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39968
diff
changeset
|
736 XSETCAR (tail, elt); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
737 prev = tail; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
738 tail = XCDR (tail); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
739 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
740 else if (VECTORP (val)) |
91667
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
741 { |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
742 ASET (val, toindex, elt); |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
743 toindex++; |
b3e6289494fb
(concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91367
diff
changeset
|
744 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
745 else |
211 | 746 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
747 CHECK_NUMBER (elt); |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
748 if (some_multibyte) |
89483 | 749 toindex_byte += CHAR_STRING (XINT (elt), |
750 SDATA (val) + toindex_byte); | |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
751 else |
89483 | 752 SSET (val, toindex_byte++, XINT (elt)); |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
753 toindex++; |
211 | 754 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
755 } |
211 | 756 } |
485 | 757 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
|
758 XSETCDR (prev, last_tail); |
211 | 759 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
760 if (num_textprops > 0) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
761 { |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
762 Lisp_Object props; |
35352
42b56dd8986e
(concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents:
35336
diff
changeset
|
763 int last_to_end = -1; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
764 |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
765 for (argnum = 0; argnum < num_textprops; argnum++) |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
766 { |
25094
4df3b9d95d4a
(concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
25093
diff
changeset
|
767 this = args[textprops[argnum].argnum]; |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
768 props = text_property_list (this, |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
769 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
|
770 make_number (SCHARS (this)), |
30024
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
771 Qnil); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
772 /* 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
|
773 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
|
774 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
|
775 make_composition_value_copy (props); |
9fd285caeb51
(concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents:
30007
diff
changeset
|
776 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
|
777 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
|
778 last_to_end = textprops[argnum].to + SCHARS (this); |
25093
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
779 } |
30bfdf581d6f
(count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents:
25080
diff
changeset
|
780 } |
58623 | 781 |
782 SAFE_FREE (); | |
20004 | 783 return val; |
211 | 784 } |
785 | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
786 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
|
787 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
|
788 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
|
789 |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
790 void |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
791 clear_string_char_byte_cache () |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
792 { |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
793 string_char_byte_cache_string = Qnil; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
794 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
795 |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
796 /* 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
|
797 |
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
798 EMACS_INT |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
799 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
|
800 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
|
801 EMACS_INT char_index; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
802 { |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
803 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
|
804 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
|
805 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
|
806 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
807 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
|
808 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
|
809 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
|
810 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
|
811 return char_index; |
20667
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 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
|
814 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
815 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
|
816 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
817 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
|
818 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
|
819 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
820 else |
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 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
|
823 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
|
824 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
825 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
826 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
827 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
|
828 { |
89483 | 829 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
|
830 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
831 while (best_below < char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
832 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
833 p += BYTES_BY_CHAR_HEAD (*p); |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
834 best_below++; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
835 } |
89483 | 836 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
|
837 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
838 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
839 { |
89483 | 840 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
|
841 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
842 while (best_above > char_index) |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
843 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
844 p--; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
845 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
|
846 best_above--; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
847 } |
89483 | 848 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
|
849 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
850 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
851 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
|
852 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
|
853 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
|
854 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
855 return i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
856 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
857 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
858 /* 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
|
859 |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
860 EMACS_INT |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
861 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
|
862 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
|
863 EMACS_INT byte_index; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
864 { |
91807
507bcfb4342c
* coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91667
diff
changeset
|
865 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
|
866 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
|
867 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
|
868 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
869 best_below = best_below_byte = 0; |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
870 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
|
871 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
|
872 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
|
873 return byte_index; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
874 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
875 if (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
|
876 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
877 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
|
878 { |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
879 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
|
880 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
|
881 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
882 else |
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 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
|
885 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
|
886 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
887 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
888 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
889 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
|
890 { |
89483 | 891 unsigned char *p = SDATA (string) + best_below_byte; |
892 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
|
893 |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
894 while (p < pend) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
895 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
896 p += BYTES_BY_CHAR_HEAD (*p); |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
897 best_below++; |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
898 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
899 i = best_below; |
89483 | 900 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
|
901 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
902 else |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
903 { |
89483 | 904 unsigned char *p = SDATA (string) + best_above_byte; |
905 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
|
906 |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
907 while (p > pbeg) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
908 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
909 p--; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
910 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
|
911 best_above--; |
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 i = best_above; |
89483 | 914 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
|
915 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
916 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
917 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
|
918 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
|
919 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
|
920 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
921 return i; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
922 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
923 |
88980 | 924 /* 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
|
925 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
926 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
927 string_make_multibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
928 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
929 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
930 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
|
931 EMACS_INT nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
932 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
933 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
934 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
935 if (STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
936 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
937 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
938 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
|
939 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
|
940 /* 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
|
941 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
|
942 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
|
943 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
944 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
945 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
|
946 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
|
947 0, 1); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
948 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
949 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
|
950 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
951 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
952 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
953 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
954 |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
955 |
89483 | 956 /* Convert STRING (if unibyte) to a multibyte string without changing |
957 the number of characters. Characters 0200 trough 0237 are | |
958 converted to eight-bit characters. */ | |
49656
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 Lisp_Object |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
961 string_to_multibyte (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
962 Lisp_Object string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
963 { |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
964 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
|
965 EMACS_INT nbytes; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
966 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
967 USE_SAFE_ALLOCA; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
968 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
969 if (STRING_MULTIBYTE (string)) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
970 return string; |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
971 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
972 nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string)); |
89483 | 973 /* If all the chars are ASCII, they won't need any more bytes once |
974 converted. */ | |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
975 if (nbytes == SBYTES (string)) |
49815
2a19e12053a4
(string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents:
49798
diff
changeset
|
976 return make_multibyte_string (SDATA (string), nbytes, nbytes); |
49656
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 SAFE_ALLOCA (buf, unsigned char *, nbytes); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
979 bcopy (SDATA (string), buf, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
980 str_to_multibyte (buf, nbytes, SBYTES (string)); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
981 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
982 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
|
983 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
984 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
985 return ret; |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
986 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
987 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
988 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
989 /* 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
|
990 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
991 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
992 string_make_unibyte (string) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
993 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
994 { |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
995 int nchars; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
996 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
|
997 Lisp_Object ret; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
998 USE_SAFE_ALLOCA; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
999 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1000 if (! STRING_MULTIBYTE (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1001 return string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1002 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1003 nchars = SCHARS (string); |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1004 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1005 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
|
1006 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
|
1007 1, 0); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1008 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
1009 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
|
1010 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
|
1011 |
6b858fb89033
* fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents:
55481
diff
changeset
|
1012 return ret; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1013 } |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1014 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1015 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
|
1016 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1017 doc: /* Return the multibyte equivalent of STRING. |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
1018 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
|
1019 `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
|
1020 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
|
1021 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
|
1022 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
|
1023 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
|
1024 \(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
|
1025 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
|
1026 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1027 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1028 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1029 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1030 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1031 return string_make_multibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1032 } |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1033 |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1034 DEFUN ("string-make-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
|
1035 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1036 doc: /* Return the unibyte equivalent of STRING. |
45650
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1037 Multibyte character codes are converted to unibyte according to |
dca52f93fdc0
(Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents:
45629
diff
changeset
|
1038 `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
|
1039 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
|
1040 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
|
1041 (string) |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1042 Lisp_Object string; |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1043 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1044 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1045 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1046 return string_make_unibyte (string); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
1047 } |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1048 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1049 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
|
1050 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1051 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
|
1052 If STRING is unibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1053 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
|
1054 If STRING is multibyte and contains a character of charset |
89909 | 1055 `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
|
1056 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1057 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
|
1058 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1059 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1060 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1061 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
|
1062 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1063 int bytes = SBYTES (string); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1064 unsigned char *str = (unsigned char *) xmalloc (bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1065 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1066 bcopy (SDATA (string), str, bytes); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1067 bytes = str_as_unibyte (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1068 string = make_unibyte_string (str, bytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1069 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
|
1070 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1071 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1072 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1073 |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1074 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
|
1075 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1076 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
|
1077 If STRING is multibyte, the result is STRING itself. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1078 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
|
1079 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1080 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
|
1081 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
|
1082 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
|
1083 See also `string-to-multibyte'. |
e938d7220d86
(Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents:
90143
diff
changeset
|
1084 |
61433
74a256d5f3ec
(Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
61417
diff
changeset
|
1085 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
|
1086 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
|
1087 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
|
1088 `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
|
1089 (string) |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1090 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
|
1091 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1092 CHECK_STRING (string); |
22165
8cdacecac78b
(Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents:
22117
diff
changeset
|
1093 |
20813
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1094 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
|
1095 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1096 Lisp_Object new_string; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1097 int nchars, nbytes; |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1098 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1099 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
|
1100 SBYTES (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1101 &nchars, &nbytes); |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1102 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
|
1103 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
|
1104 SBYTES (string)); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1105 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
|
1106 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
|
1107 SBYTES (string), NULL); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
1108 string = new_string; |
46379
18cf1d2514d9
* fns.c (Fstring_as_multibyte): Use STRING_SET_INTERVALS.
Ken Raeburn <raeburn@raeburn.org>
parents:
46374
diff
changeset
|
1109 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
|
1110 } |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1111 return string; |
b040da7cfab8
(concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents:
20776
diff
changeset
|
1112 } |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1113 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1114 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
|
1115 1, 1, 0, |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1116 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
|
1117 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
|
1118 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
|
1119 |
b18e038d980f
(Fstring_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
88864
diff
changeset
|
1120 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
|
1121 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
|
1122 |
61d0db65f8e4
(Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents:
89196
diff
changeset
|
1123 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
|
1124 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
|
1125 correct sequence. */) |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1126 (string) |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1127 Lisp_Object 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 CHECK_STRING (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1130 |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1131 return string_to_multibyte (string); |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1132 } |
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
1133 |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1134 DEFUN ("string-to-unibyte", Fstring_to_unibyte, Sstring_to_unibyte, |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1135 1, 2, 0, |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1136 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
|
1137 If STRING is unibyte, the result is STRING itself. |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1138 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
|
1139 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
|
1140 If STRING contains a non-ASCII, non-`eight-bit' character, |
96271
0073930415c3
(Fstring_to_unibyte): Fix the previous change.
Kenichi Handa <handa@m17n.org>
parents:
96255
diff
changeset
|
1141 an error is signaled. |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1142 If the optional 2nd arg ACCEPT-LATIN-1 is non-nil, a Latin-1 character |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1143 doesn't cause an error, but is converted to a byte of same code. */) |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1144 (string, accept_latin_1) |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1145 Lisp_Object string, accept_latin_1; |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1146 { |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1147 CHECK_STRING (string); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1148 |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1149 if (STRING_MULTIBYTE (string)) |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1150 { |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1151 EMACS_INT chars = SCHARS (string); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1152 unsigned char *str = (unsigned char *) xmalloc (chars); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1153 EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1154 ! NILP (accept_latin_1)); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1155 if (converted < chars) |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1156 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
|
1157 string = make_unibyte_string (str, chars); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1158 xfree (str); |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1159 } |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1160 return string; |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1161 } |
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
1162 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1163 |
211 | 1164 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
|
1165 doc: /* Return a copy of ALIST. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1166 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
|
1167 but does not share the alist structure with ALIST. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1168 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
|
1169 are shared, however. |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1170 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
|
1171 (alist) |
211 | 1172 Lisp_Object alist; |
1173 { | |
1174 register Lisp_Object tem; | |
1175 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1176 CHECK_LIST (alist); |
485 | 1177 if (NILP (alist)) |
211 | 1178 return alist; |
1179 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
|
1180 for (tem = alist; CONSP (tem); tem = XCDR (tem)) |
211 | 1181 { |
1182 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
|
1183 car = XCAR (tem); |
211 | 1184 |
1185 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
|
1186 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); |
211 | 1187 } |
1188 return alist; | |
1189 } | |
1190 | |
1191 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0, | |
41006 | 1192 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
|
1193 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
|
1194 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
|
1195 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1196 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
|
1197 (string, from, to) |
211 | 1198 Lisp_Object string; |
1199 register Lisp_Object from, to; | |
1200 { | |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1201 Lisp_Object res; |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1202 int size; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1203 int size_byte = 0; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1204 int from_char, to_char; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
1205 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
|
1206 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1207 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
|
1208 CHECK_NUMBER (from); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1209 |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1210 if (STRINGP (string)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1211 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1212 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
|
1213 size_byte = SBYTES (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1214 } |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1215 else |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
1216 size = ASIZE (string); |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1217 |
485 | 1218 if (NILP (to)) |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1219 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1220 to_char = size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1221 to_byte = size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1222 } |
211 | 1223 else |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1224 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1225 CHECK_NUMBER (to); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1226 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1227 to_char = XINT (to); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1228 if (to_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1229 to_char += size; |
211 | 1230 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1231 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1232 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
|
1233 } |
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 from_char = XINT (from); |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1236 if (from_char < 0) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1237 from_char += size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1238 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1239 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
|
1240 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1241 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
|
1242 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
|
1243 make_number (to_char)); |
211 | 1244 |
15966
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1245 if (STRINGP (string)) |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1246 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1247 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
|
1248 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
|
1249 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1250 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
|
1251 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
|
1252 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1253 else |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
1254 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
|
1255 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1256 return res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1257 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1258 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1259 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1260 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
|
1261 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
|
1262 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
|
1263 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
|
1264 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
|
1265 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
|
1266 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1267 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
|
1268 (string, from, to) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1269 Lisp_Object string; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1270 register Lisp_Object from, to; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1271 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1272 int size, size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1273 int from_char, to_char; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1274 int from_byte, to_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1275 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1276 CHECK_STRING (string); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1277 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1278 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
|
1279 size_byte = SBYTES (string); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1280 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1281 if (NILP (from)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1282 from_char = from_byte = 0; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1283 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1284 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1285 CHECK_NUMBER (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1286 from_char = XINT (from); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1287 if (from_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1288 from_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1289 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1290 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
|
1291 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1292 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1293 if (NILP (to)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1294 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1295 to_char = size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1296 to_byte = size_byte; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1297 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1298 else |
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 CHECK_NUMBER (to); |
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 to_char = XINT (to); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1303 if (to_char < 0) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1304 to_char += size; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1305 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1306 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
|
1307 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1308 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1309 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
|
1310 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
|
1311 make_number (to_char)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1312 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1313 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
|
1314 to_char - from_char, to_byte - from_byte, |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1315 STRING_MULTIBYTE (string)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1316 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
1317 |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1318 /* 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
|
1319 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
|
1320 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1321 Lisp_Object |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1322 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
|
1323 Lisp_Object string; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1324 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
|
1325 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1326 Lisp_Object res; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1327 int size; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1328 int size_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1329 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1330 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
|
1331 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1332 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1333 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1334 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
|
1335 size_byte = SBYTES (string); |
20607
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 else |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
1338 size = ASIZE (string); |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1339 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1340 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
|
1341 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
|
1342 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1343 if (STRINGP (string)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
1344 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1345 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
|
1346 to - from, to_byte - from_byte, |
4ac9ba6e745d
(substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1347 STRING_MULTIBYTE (string)); |
21523
33d800bf97c3
(Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents:
21514
diff
changeset
|
1348 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
|
1349 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
|
1350 } |
ceb8d03a04f6
(Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents:
15713
diff
changeset
|
1351 else |
74169
a2250a4829ad
(substring_both): Add missing address operator.
Juanma Barranquero <lekktu@gmail.com>
parents:
74163
diff
changeset
|
1352 res = Fvector (to - from, &AREF (string, from)); |
20004 | 1353 |
4004
71541ea16adf
* fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents:
3379
diff
changeset
|
1354 return res; |
211 | 1355 } |
1356 | |
1357 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
|
1358 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
|
1359 (n, list) |
211 | 1360 Lisp_Object n; |
1361 register Lisp_Object list; | |
1362 { | |
1363 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
|
1364 CHECK_NUMBER (n); |
211 | 1365 num = XINT (n); |
485 | 1366 for (i = 0; i < num && !NILP (list); i++) |
211 | 1367 { |
1368 QUIT; | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1369 CHECK_LIST_CONS (list, list); |
26596 | 1370 list = XCDR (list); |
211 | 1371 } |
1372 return list; | |
1373 } | |
1374 | |
1375 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
|
1376 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
|
1377 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
|
1378 (n, list) |
211 | 1379 Lisp_Object n, list; |
1380 { | |
1381 return Fcar (Fnthcdr (n, list)); | |
1382 } | |
1383 | |
1384 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
|
1385 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
|
1386 (sequence, n) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1387 register Lisp_Object sequence, n; |
211 | 1388 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1389 CHECK_NUMBER (n); |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1390 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
|
1391 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
|
1392 |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1393 /* 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
|
1394 CHECK_ARRAY (sequence, Qsequencep); |
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1395 return Faref (sequence, n); |
211 | 1396 } |
1397 | |
1398 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
|
1399 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
|
1400 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
|
1401 (elt, list) |
211 | 1402 register Lisp_Object elt; |
1403 Lisp_Object list; | |
1404 { | |
1405 register Lisp_Object tail; | |
85330
0bc184c59770
* xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
85114
diff
changeset
|
1406 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
211 | 1407 { |
1408 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
|
1409 CHECK_LIST_CONS (tail, list); |
26596 | 1410 tem = XCAR (tail); |
485 | 1411 if (! NILP (Fequal (elt, tem))) |
211 | 1412 return tail; |
1413 QUIT; | |
1414 } | |
1415 return Qnil; | |
1416 } | |
1417 | |
1418 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, | |
73029 | 1419 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. |
1420 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
|
1421 (elt, list) |
73029 | 1422 register Lisp_Object elt, list; |
211 | 1423 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1424 while (1) |
211 | 1425 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1426 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1427 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1428 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1429 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1430 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1431 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1432 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1433 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1434 if (!CONSP (list) || EQ (XCAR (list), elt)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1435 break; |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1436 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1437 list = XCDR (list); |
211 | 1438 QUIT; |
1439 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1440 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1441 CHECK_LIST (list); |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1442 return list; |
211 | 1443 } |
1444 | |
73029 | 1445 DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, |
1446 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. | |
1447 The value is actually the tail of LIST whose car is ELT. */) | |
1448 (elt, list) | |
1449 register Lisp_Object elt; | |
1450 Lisp_Object list; | |
1451 { | |
1452 register Lisp_Object tail; | |
1453 | |
1454 if (!FLOATP (elt)) | |
1455 return Fmemq (elt, list); | |
1456 | |
85330
0bc184c59770
* xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
85114
diff
changeset
|
1457 for (tail = list; CONSP (tail); tail = XCDR (tail)) |
73029 | 1458 { |
1459 register Lisp_Object tem; | |
1460 CHECK_LIST_CONS (tail, list); | |
1461 tem = XCAR (tail); | |
1462 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0)) | |
1463 return tail; | |
1464 QUIT; | |
1465 } | |
1466 return Qnil; | |
1467 } | |
1468 | |
211 | 1469 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
|
1470 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
|
1471 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
|
1472 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
|
1473 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1474 Lisp_Object key, list; |
211 | 1475 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1476 while (1) |
211 | 1477 { |
26230
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); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1490 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1491 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1492 && EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1493 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1494 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1495 list = XCDR (list); |
211 | 1496 QUIT; |
1497 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1498 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1499 return CAR (list); |
211 | 1500 } |
1501 | |
1502 /* Like Fassq but never report an error and do not allow quits. | |
1503 Use only on lists known never to be circular. */ | |
1504 | |
1505 Lisp_Object | |
1506 assq_no_quit (key, list) | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1507 Lisp_Object key, list; |
211 | 1508 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1509 while (CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1510 && (!CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1511 || !EQ (XCAR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1512 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1513 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1514 return CAR_SAFE (list); |
211 | 1515 } |
1516 | |
1517 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
|
1518 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
|
1519 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
|
1520 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1521 Lisp_Object key, list; |
211 | 1522 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1523 Lisp_Object car; |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1524 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1525 while (1) |
211 | 1526 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1527 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1528 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1529 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1530 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1531 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1532 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1533 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1534 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1535 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1536 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1537 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1538 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1539 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1540 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1541 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1542 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1543 && (car = XCAR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1544 EQ (car, key) || !NILP (Fequal (car, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1545 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1546 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1547 list = XCDR (list); |
211 | 1548 QUIT; |
1549 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1550 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1551 return CAR (list); |
211 | 1552 } |
1553 | |
90408
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1554 /* 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
|
1555 Use only on lists known never to be circular. */ |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1556 |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1557 Lisp_Object |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1558 assoc_no_quit (key, list) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1559 Lisp_Object key, 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 while (CONSP (list) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1562 && (!CONSP (XCAR (list)) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1563 || (!EQ (XCAR (XCAR (list)), key) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1564 && NILP (Fequal (XCAR (XCAR (list)), key))))) |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1565 list = XCDR (list); |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1566 |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1567 return CONSP (list) ? XCAR (list) : Qnil; |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1568 } |
cc49fe5026c6
(assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents:
90384
diff
changeset
|
1569 |
211 | 1570 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
|
1571 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
|
1572 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
|
1573 (key, list) |
211 | 1574 register Lisp_Object key; |
1575 Lisp_Object list; | |
1576 { | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1577 while (1) |
211 | 1578 { |
26230
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); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1591 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1592 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1593 && EQ (XCDR (XCAR (list)), key))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1594 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1595 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1596 list = XCDR (list); |
211 | 1597 QUIT; |
1598 } | |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1599 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1600 return CAR (list); |
211 | 1601 } |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1602 |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1603 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
|
1604 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
|
1605 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
|
1606 (key, list) |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1607 Lisp_Object key, list; |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1608 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1609 Lisp_Object cdr; |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1610 |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1611 while (1) |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1612 { |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1613 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1614 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1615 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1616 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1617 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1618 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1619 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1620 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1621 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1622 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1623 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1624 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1625 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1626 list = XCDR (list); |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1627 if (!CONSP (list) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1628 || (CONSP (XCAR (list)) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1629 && (cdr = XCDR (XCAR (list)), |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1630 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) |
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1631 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1632 |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1633 list = XCDR (list); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1634 QUIT; |
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1635 } |
26230
d44efc0b3243
(Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents:
26088
diff
changeset
|
1636 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1637 return CAR (list); |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
1638 } |
211 | 1639 |
1640 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
|
1641 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
|
1642 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
|
1643 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
|
1644 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
|
1645 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
|
1646 (elt, list) |
211 | 1647 register Lisp_Object elt; |
1648 Lisp_Object list; | |
1649 { | |
1650 register Lisp_Object tail, prev; | |
1651 register Lisp_Object tem; | |
1652 | |
1653 tail = list; | |
1654 prev = Qnil; | |
485 | 1655 while (!NILP (tail)) |
211 | 1656 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1657 CHECK_LIST_CONS (tail, list); |
26596 | 1658 tem = XCAR (tail); |
211 | 1659 if (EQ (elt, tem)) |
1660 { | |
485 | 1661 if (NILP (prev)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1662 list = XCDR (tail); |
211 | 1663 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1664 Fsetcdr (prev, XCDR (tail)); |
211 | 1665 } |
1666 else | |
1667 prev = tail; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1668 tail = XCDR (tail); |
211 | 1669 QUIT; |
1670 } | |
1671 return list; | |
1672 } | |
1673 | |
414 | 1674 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
|
1675 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
|
1676 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
|
1677 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
|
1678 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
|
1679 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
|
1680 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
|
1681 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
|
1682 (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
|
1683 Lisp_Object elt, seq; |
401 | 1684 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1685 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
|
1686 { |
34961
d033c08f2ac6
(Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents:
34722
diff
changeset
|
1687 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
|
1688 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1689 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
|
1690 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
|
1691 ++n; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1692 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1693 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
|
1694 { |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
1695 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
|
1696 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1697 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
|
1698 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
|
1699 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
|
1700 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1701 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
|
1702 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1703 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1704 else if (STRINGP (seq)) |
401 | 1705 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1706 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
|
1707 int c; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1708 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1709 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
|
1710 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
|
1711 ++i, ibyte += cbytes) |
401 | 1712 { |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1713 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
|
1714 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1715 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
|
1716 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
|
1717 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
|
1718 } |
401 | 1719 else |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1720 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1721 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
|
1722 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1723 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
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 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
|
1726 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1727 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1728 nbytes += cbytes; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1729 } |
401 | 1730 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1731 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1732 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
|
1733 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1734 Lisp_Object tem; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1735 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1736 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
|
1737 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
|
1738 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
|
1739 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1740 for (i = 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
|
1741 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
|
1742 ++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
|
1743 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1744 if (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
|
1745 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1746 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
|
1747 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
|
1748 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
|
1749 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1750 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1751 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
1752 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
|
1753 cbytes = 1; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1754 } |
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 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
|
1757 { |
46425
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1758 unsigned char *from = SDATA (seq) + ibyte; |
2e674544b19a
* fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents:
46379
diff
changeset
|
1759 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
|
1760 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
|
1761 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1762 ++nchars; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1763 nbytes += cbytes; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1764 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1765 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
|
1766 *to++ = *from++; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1767 } |
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 |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1770 seq = tem; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1771 } |
401 | 1772 } |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1773 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1774 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1775 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
|
1776 |
85330
0bc184c59770
* xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
85114
diff
changeset
|
1777 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
|
1778 { |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1779 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
|
1780 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1781 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
|
1782 { |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1783 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
|
1784 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
|
1785 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1786 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
|
1787 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1788 else |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1789 prev = tail; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1790 QUIT; |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1791 } |
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1792 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
1793 |
30510
4a2abe231277
(Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents:
30496
diff
changeset
|
1794 return seq; |
401 | 1795 } |
1796 | |
211 | 1797 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
|
1798 doc: /* Reverse LIST by modifying cdr pointers. |
53106 | 1799 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
|
1800 (list) |
211 | 1801 Lisp_Object list; |
1802 { | |
1803 register Lisp_Object prev, tail, next; | |
1804 | |
485 | 1805 if (NILP (list)) return list; |
211 | 1806 prev = Qnil; |
1807 tail = list; | |
485 | 1808 while (!NILP (tail)) |
211 | 1809 { |
1810 QUIT; | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1811 CHECK_LIST_CONS (tail, list); |
26596 | 1812 next = XCDR (tail); |
211 | 1813 Fsetcdr (tail, prev); |
1814 prev = tail; | |
1815 tail = next; | |
1816 } | |
1817 return prev; | |
1818 } | |
1819 | |
1820 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0, | |
53106 | 1821 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
|
1822 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
|
1823 (list) |
211 | 1824 Lisp_Object list; |
1825 { | |
18421 | 1826 Lisp_Object new; |
211 | 1827 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
1828 for (new = Qnil; CONSP (list); list = XCDR (list)) |
49204 | 1829 { |
1830 QUIT; | |
1831 new = Fcons (XCAR (list), new); | |
1832 } | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1833 CHECK_LIST_END (list, list); |
18421 | 1834 return new; |
211 | 1835 } |
1836 | |
1837 Lisp_Object merge (); | |
1838 | |
1839 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
|
1840 doc: /* Sort LIST, stably, comparing elements using PREDICATE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1841 Returns the sorted list. LIST is modified by side effects. |
63602 | 1842 PREDICATE is called with two elements of LIST, and should return non-nil |
65325 | 1843 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
|
1844 (list, predicate) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1845 Lisp_Object list, predicate; |
211 | 1846 { |
1847 Lisp_Object front, back; | |
1848 register Lisp_Object len, tem; | |
1849 struct gcpro gcpro1, gcpro2; | |
1850 register int length; | |
1851 | |
1852 front = list; | |
1853 len = Flength (list); | |
1854 length = XINT (len); | |
1855 if (length < 2) | |
1856 return list; | |
1857 | |
1858 XSETINT (len, (length / 2) - 1); | |
1859 tem = Fnthcdr (len, list); | |
1860 back = Fcdr (tem); | |
1861 Fsetcdr (tem, Qnil); | |
1862 | |
1863 GCPRO2 (front, back); | |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1864 front = Fsort (front, predicate); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1865 back = Fsort (back, predicate); |
211 | 1866 UNGCPRO; |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
1867 return merge (front, back, predicate); |
211 | 1868 } |
1869 | |
1870 Lisp_Object | |
1871 merge (org_l1, org_l2, pred) | |
1872 Lisp_Object org_l1, org_l2; | |
1873 Lisp_Object pred; | |
1874 { | |
1875 Lisp_Object value; | |
1876 register Lisp_Object tail; | |
1877 Lisp_Object tem; | |
1878 register Lisp_Object l1, l2; | |
1879 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1880 | |
1881 l1 = org_l1; | |
1882 l2 = org_l2; | |
1883 tail = Qnil; | |
1884 value = Qnil; | |
1885 | |
1886 /* It is sufficient to protect org_l1 and org_l2. | |
1887 When l1 and l2 are updated, we copy the new values | |
1888 back into the org_ vars. */ | |
1889 GCPRO4 (org_l1, org_l2, pred, value); | |
1890 | |
1891 while (1) | |
1892 { | |
485 | 1893 if (NILP (l1)) |
211 | 1894 { |
1895 UNGCPRO; | |
485 | 1896 if (NILP (tail)) |
211 | 1897 return l2; |
1898 Fsetcdr (tail, l2); | |
1899 return value; | |
1900 } | |
485 | 1901 if (NILP (l2)) |
211 | 1902 { |
1903 UNGCPRO; | |
485 | 1904 if (NILP (tail)) |
211 | 1905 return l1; |
1906 Fsetcdr (tail, l1); | |
1907 return value; | |
1908 } | |
1909 tem = call2 (pred, Fcar (l2), Fcar (l1)); | |
485 | 1910 if (NILP (tem)) |
211 | 1911 { |
1912 tem = l1; | |
1913 l1 = Fcdr (l1); | |
1914 org_l1 = l1; | |
1915 } | |
1916 else | |
1917 { | |
1918 tem = l2; | |
1919 l2 = Fcdr (l2); | |
1920 org_l2 = l2; | |
1921 } | |
485 | 1922 if (NILP (tail)) |
211 | 1923 value = tem; |
1924 else | |
1925 Fsetcdr (tail, tem); | |
1926 tail = tem; | |
1927 } | |
1928 } | |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1929 |
211 | 1930 |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1931 #if 0 /* Unsafe version. */ |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1932 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
|
1933 doc: /* Extract a value from a property list. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1934 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
|
1935 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
1936 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
|
1937 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
|
1938 (plist, prop) |
14051
7f7e97f219ce
(Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents:
13862
diff
changeset
|
1939 Lisp_Object plist; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1940 Lisp_Object prop; |
211 | 1941 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1942 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1943 |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1944 for (tail = plist; |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1945 CONSP (tail) && CONSP (XCDR (tail)); |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1946 tail = XCDR (XCDR (tail))) |
211 | 1947 { |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1948 if (EQ (prop, XCAR (tail))) |
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1949 return XCAR (XCDR (tail)); |
37317
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1950 |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1951 /* 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
|
1952 (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
|
1953 if (!interrupt_input_blocked) |
36d04528f2aa
(Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents:
37309
diff
changeset
|
1954 QUIT; |
211 | 1955 } |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
1956 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
1957 CHECK_LIST_END (tail, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
1958 |
211 | 1959 return Qnil; |
1960 } | |
61723
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1961 #endif |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1962 |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1963 /* 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
|
1964 |
afe4f19c3436
(Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents:
61687
diff
changeset
|
1965 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
|
1966 doc: /* Extract a value from a property list. |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1967 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
|
1968 \(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
|
1969 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
|
1970 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
|
1971 (plist, prop) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1972 Lisp_Object plist; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1973 Lisp_Object prop; |
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 Lisp_Object tail, halftail; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1976 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1977 /* halftail is used to detect circular lists. */ |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1978 tail = halftail = plist; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1979 while (CONSP (tail) && CONSP (XCDR (tail))) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1980 { |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1981 if (EQ (prop, XCAR (tail))) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1982 return XCAR (XCDR (tail)); |
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 tail = XCDR (XCDR (tail)); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1985 halftail = XCDR (halftail); |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1986 if (EQ (tail, halftail)) |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1987 break; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1988 } |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1989 |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1990 return Qnil; |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1991 } |
6c9552cf734a
(Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents:
57988
diff
changeset
|
1992 |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1993 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
|
1994 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
|
1995 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
|
1996 (symbol, propname) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
1997 Lisp_Object symbol, propname; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
1998 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
1999 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2000 return Fplist_get (XSYMBOL (symbol)->plist, propname); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2001 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2002 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2003 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
|
2004 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
|
2005 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
|
2006 \(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
|
2007 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
|
2008 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
|
2009 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
|
2010 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
|
2011 (plist, prop, val) |
20004 | 2012 Lisp_Object plist; |
2013 register Lisp_Object prop; | |
2014 Lisp_Object val; | |
211 | 2015 { |
2016 register Lisp_Object tail, prev; | |
2017 Lisp_Object newcell; | |
2018 prev = Qnil; | |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2019 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
|
2020 tail = XCDR (XCDR (tail))) |
211 | 2021 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2022 if (EQ (prop, XCAR (tail))) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2023 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2024 Fsetcar (XCDR (tail), val); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2025 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2026 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2027 |
211 | 2028 prev = tail; |
37279
c706f3e5efe0
(Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents:
37208
diff
changeset
|
2029 QUIT; |
211 | 2030 } |
78824
c33d8980019c
(Fplist_put): Preserve uneven tail data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78260
diff
changeset
|
2031 newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); |
485 | 2032 if (NILP (prev)) |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2033 return newcell; |
211 | 2034 else |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2035 Fsetcdr (XCDR (prev), newcell); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2036 return plist; |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2037 } |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2038 |
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2039 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
|
2040 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
|
2041 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
|
2042 (symbol, propname, value) |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2043 Lisp_Object symbol, propname, value; |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
2044 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2045 CHECK_SYMBOL (symbol); |
11138
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2046 XSYMBOL (symbol)->plist |
8eed13a00d2b
(Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents:
11130
diff
changeset
|
2047 = 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
|
2048 return value; |
211 | 2049 } |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2050 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2051 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
|
2052 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
|
2053 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
|
2054 \(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
|
2055 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
|
2056 one of the properties on the list. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2057 (plist, prop) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2058 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2059 Lisp_Object prop; |
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 Lisp_Object tail; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2062 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2063 for (tail = plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2064 CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2065 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2066 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2067 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2068 return XCAR (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2069 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2070 QUIT; |
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 |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
2073 CHECK_LIST_END (tail, prop); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2074 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2075 return Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2076 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2077 |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2078 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
|
2079 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
|
2080 PLIST is a property list, which is a list of the form |
44219 | 2081 \(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
|
2082 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
|
2083 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
|
2084 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
|
2085 The PLIST is modified by side effects. */) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2086 (plist, prop, val) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2087 Lisp_Object plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2088 register Lisp_Object prop; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2089 Lisp_Object val; |
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 register Lisp_Object tail, prev; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2092 Lisp_Object newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2093 prev = Qnil; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2094 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2095 tail = XCDR (XCDR (tail))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2096 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2097 if (! NILP (Fequal (prop, XCAR (tail)))) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2098 { |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2099 Fsetcar (XCDR (tail), val); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2100 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2101 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2102 |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2103 prev = tail; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2104 QUIT; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2105 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2106 newcell = Fcons (prop, Fcons (val, Qnil)); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2107 if (NILP (prev)) |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2108 return newcell; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2109 else |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2110 Fsetcdr (XCDR (prev), newcell); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2111 return plist; |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2112 } |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
2113 |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2114 DEFUN ("eql", Feql, Seql, 2, 2, 0, |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2115 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
|
2116 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
|
2117 (obj1, obj2) |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2118 Lisp_Object obj1, obj2; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2119 { |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2120 if (FLOATP (obj1)) |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2121 return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2122 else |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2123 return EQ (obj1, obj2) ? Qt : Qnil; |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2124 } |
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
2125 |
211 | 2126 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
|
2127 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
|
2128 They must have the same data type. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2129 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
|
2130 Vectors and strings are compared element by element. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2131 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
|
2132 (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
|
2133 Symbols must match exactly. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2134 (o1, o2) |
211 | 2135 register Lisp_Object o1, o2; |
2136 { | |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2137 return internal_equal (o1, o2, 0, 0) ? Qt : Qnil; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2138 } |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2139 |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2140 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
|
2141 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
|
2142 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
|
2143 of strings. (`equal' ignores text properties.) */) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2144 (o1, o2) |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2145 register Lisp_Object o1, o2; |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2146 { |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2147 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
|
2148 } |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2149 |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2150 /* 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
|
2151 gets too deep. |
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2152 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
|
2153 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2154 static int |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2155 internal_equal (o1, o2, depth, props) |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2156 register Lisp_Object o1, o2; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2157 int depth, props; |
399
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2158 { |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2159 if (depth > 200) |
21aa17a1560d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
350
diff
changeset
|
2160 error ("Stack overflow in equal"); |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2161 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2162 tail_recurse: |
211 | 2163 QUIT; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2164 if (EQ (o1, o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2165 return 1; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2166 if (XTYPE (o1) != XTYPE (o2)) |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2167 return 0; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2168 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2169 switch (XTYPE (o1)) |
211 | 2170 { |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2171 case Lisp_Float: |
53393
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2172 { |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2173 double d1, d2; |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2174 |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2175 d1 = extract_float (o1); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2176 d2 = extract_float (o2); |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2177 /* 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
|
2178 though they are not =. */ |
6658b72a5f99
(internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53259
diff
changeset
|
2179 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
|
2180 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2181 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2182 case Lisp_Cons: |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2183 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
|
2184 return 0; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2185 o1 = XCDR (o1); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2186 o2 = XCDR (o2); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2187 goto tail_recurse; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2188 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2189 case Lisp_Misc: |
11240
2642924d2d21
(internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
2190 if (XMISCTYPE (o1) != XMISCTYPE (o2)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2191 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2192 if (OVERLAYP (o1)) |
211 | 2193 { |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2194 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
|
2195 depth + 1, props) |
25149
ee483f870bde
(internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents:
25094
diff
changeset
|
2196 || !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
|
2197 depth + 1, props)) |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2198 return 0; |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2199 o1 = XOVERLAY (o1)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2200 o2 = XOVERLAY (o2)->plist; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2201 goto tail_recurse; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2202 } |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2203 if (MARKERP (o1)) |
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 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
|
2206 && (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
|
2207 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); |
211 | 2208 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2209 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2210 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2211 case Lisp_Vectorlike: |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2212 { |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2213 register int i; |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2214 EMACS_INT size = ASIZE (o1); |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2215 /* 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
|
2216 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
|
2217 same size. */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2218 if (ASIZE (o2) != size) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2219 return 0; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2220 /* Boolvectors are compared much like strings. */ |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2221 if (BOOL_VECTOR_P (o1)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2222 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2223 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2224 = ((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
|
2225 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2226 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2227 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
|
2228 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2229 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
|
2230 size_in_chars)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2231 return 0; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2232 return 1; |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2233 } |
20776
219fdecc30d3
(internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents:
20712
diff
changeset
|
2234 if (WINDOW_CONFIGURATIONP (o1)) |
21021
7be2384fabdc
(internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents:
20992
diff
changeset
|
2235 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
|
2236 |
94929
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2237 /* Aside from them, only true vectors, char-tables, compiled |
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2238 functions, and fonts (font-spec, font-entity, font-ojbect) |
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2239 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
|
2240 if (size & PSEUDOVECTOR_FLAG) |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2241 { |
89483 | 2242 if (!(size & (PVEC_COMPILED |
94929
b9ffe341b5c8
(internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents:
93072
diff
changeset
|
2243 | 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
|
2244 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2245 size &= PSEUDOVECTOR_SIZE_MASK; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2246 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2247 for (i = 0; i < size; i++) |
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 Lisp_Object v1, v2; |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2250 v1 = AREF (o1, i); |
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2251 v2 = AREF (o2, i); |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2252 if (!internal_equal (v1, v2, depth + 1, props)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2253 return 0; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2254 } |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2255 return 1; |
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2256 } |
10405
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2257 break; |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2258 |
609f34c0c7bc
(internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents:
10289
diff
changeset
|
2259 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
|
2260 if (SCHARS (o1) != SCHARS (o2)) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2261 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
|
2262 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
|
2263 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
|
2264 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
|
2265 SBYTES (o1))) |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2266 return 0; |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
2267 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
|
2268 return 0; |
10411
b3c03881e6f6
(internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents:
10405
diff
changeset
|
2269 return 1; |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2270 |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2271 case Lisp_Int: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2272 case Lisp_Symbol: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2273 case Lisp_Type_Limit: |
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2274 break; |
211 | 2275 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2276 |
9927
05aa745fc829
(internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9439
diff
changeset
|
2277 return 0; |
211 | 2278 } |
2279 | |
18613
614b916ff5bf
Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents:
18531
diff
changeset
|
2280 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
|
2281 |
211 | 2282 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
|
2283 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
|
2284 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
|
2285 (array, item) |
211 | 2286 Lisp_Object array, item; |
2287 { | |
2288 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
|
2289 if (VECTORP (array)) |
211 | 2290 { |
2291 register Lisp_Object *p = XVECTOR (array)->contents; | |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2292 size = ASIZE (array); |
211 | 2293 for (index = 0; index < size; index++) |
2294 p[index] = item; | |
2295 } | |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2296 else if (CHAR_TABLE_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2297 { |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2298 int i; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2299 |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2300 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
|
2301 XCHAR_TABLE (array)->contents[i] = item; |
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
2302 XCHAR_TABLE (array)->defalt = item; |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2303 } |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2304 else if (STRINGP (array)) |
211 | 2305 { |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2306 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
|
2307 CHECK_NUMBER (item); |
211 | 2308 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
|
2309 size = SCHARS (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2310 if (STRING_MULTIBYTE (array)) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2311 { |
26856
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
2312 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
|
2313 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
|
2314 int size_byte = SBYTES (array); |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2315 unsigned char *p1 = p, *endp = p + size_byte; |
23453
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2316 int i; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2317 |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2318 if (size != size_byte) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2319 while (p1 < endp) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2320 { |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2321 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2322 if (len != this_len) |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2323 error ("Attempt to change byte length of a string"); |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2324 p1 += this_len; |
fa66133ad026
(Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents:
23424
diff
changeset
|
2325 } |
23424
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2326 for (i = 0; i < size_byte; i++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2327 *p++ = str[i % len]; |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2328 } |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2329 else |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2330 for (index = 0; index < size; index++) |
982f97638a8e
(clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents:
23208
diff
changeset
|
2331 p[index] = charval; |
211 | 2332 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2333 else if (BOOL_VECTOR_P (array)) |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2334 { |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2335 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
|
2336 int size_in_chars |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2337 = ((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
|
2338 / BOOL_VECTOR_BITS_PER_CHAR); |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2339 |
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2340 charval = (! NILP (item) ? -1 : 0); |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2341 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
|
2342 p[index] = charval; |
53159
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2343 if (index < size_in_chars) |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2344 { |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2345 /* 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
|
2346 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
|
2347 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
|
2348 p[index] = charval; |
e929f6d1593b
(internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents:
53138
diff
changeset
|
2349 } |
13140
99c5d39b9531
(Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12618
diff
changeset
|
2350 } |
211 | 2351 else |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
2352 wrong_type_argument (Qarrayp, array); |
211 | 2353 return array; |
2354 } | |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2355 |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2356 DEFUN ("clear-string", Fclear_string, Sclear_string, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2357 1, 1, 0, |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2358 doc: /* Clear the contents of STRING. |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2359 This makes STRING unibyte and may change its length. */) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2360 (string) |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2361 Lisp_Object string; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2362 { |
56364
78e8df7d1ad8
(Fclear_string): Correct previous change.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56361
diff
changeset
|
2363 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
|
2364 CHECK_STRING (string); |
56364
78e8df7d1ad8
(Fclear_string): Correct previous change.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56361
diff
changeset
|
2365 len = SBYTES (string); |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2366 bzero (SDATA (string), len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2367 STRING_SET_CHARS (string, len); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2368 STRING_SET_UNIBYTE (string); |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2369 return Qnil; |
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
2370 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2371 |
211 | 2372 /* ARGSUSED */ |
2373 Lisp_Object | |
2374 nconc2 (s1, s2) | |
2375 Lisp_Object s1, s2; | |
2376 { | |
2377 #ifdef NO_ARG_ARRAY | |
2378 Lisp_Object args[2]; | |
2379 args[0] = s1; | |
2380 args[1] = s2; | |
2381 return Fnconc (2, args); | |
2382 #else | |
2383 return Fnconc (2, &s1); | |
2384 #endif /* NO_ARG_ARRAY */ | |
2385 } | |
2386 | |
2387 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
|
2388 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
|
2389 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
|
2390 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
|
2391 (nargs, args) |
211 | 2392 int nargs; |
2393 Lisp_Object *args; | |
2394 { | |
2395 register int argnum; | |
2396 register Lisp_Object tail, tem, val; | |
2397 | |
31533
3898245f639a
(concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents:
30760
diff
changeset
|
2398 val = tail = Qnil; |
211 | 2399 |
2400 for (argnum = 0; argnum < nargs; argnum++) | |
2401 { | |
2402 tem = args[argnum]; | |
485 | 2403 if (NILP (tem)) continue; |
211 | 2404 |
485 | 2405 if (NILP (val)) |
211 | 2406 val = tem; |
2407 | |
2408 if (argnum + 1 == nargs) break; | |
2409 | |
71833
1b88c4bbacbc
(Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents:
70939
diff
changeset
|
2410 CHECK_LIST_CONS (tem, tem); |
211 | 2411 |
2412 while (CONSP (tem)) | |
2413 { | |
2414 tail = tem; | |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2415 tem = XCDR (tail); |
211 | 2416 QUIT; |
2417 } | |
2418 | |
2419 tem = args[argnum + 1]; | |
2420 Fsetcdr (tail, tem); | |
485 | 2421 if (NILP (tem)) |
211 | 2422 args[argnum + 1] = tail; |
2423 } | |
2424 | |
2425 return val; | |
2426 } | |
2427 | |
2428 /* 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
|
2429 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
|
2430 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
|
2431 LENI is the length of VALS, which should also be the length of SEQ. */ |
211 | 2432 |
2433 static void | |
2434 mapcar1 (leni, vals, fn, seq) | |
2435 int leni; | |
2436 Lisp_Object *vals; | |
2437 Lisp_Object fn, seq; | |
2438 { | |
2439 register Lisp_Object tail; | |
2440 Lisp_Object dummy; | |
2441 register int i; | |
2442 struct gcpro gcpro1, gcpro2, gcpro3; | |
2443 | |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2444 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2445 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2446 /* 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
|
2447 for (i = 0; i < leni; i++) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2448 vals[i] = Qnil; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2449 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2450 GCPRO3 (dummy, fn, seq); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2451 gcpro1.var = vals; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2452 gcpro1.nvars = leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2453 } |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2454 else |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2455 GCPRO2 (fn, seq); |
211 | 2456 /* 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
|
2457 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
|
2458 be freed */ |
211 | 2459 |
9128
04a702d7f662
(Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents:
8966
diff
changeset
|
2460 if (VECTORP (seq)) |
211 | 2461 { |
2462 for (i = 0; i < leni; i++) | |
2463 { | |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
2464 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
|
2465 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2466 vals[i] = dummy; |
211 | 2467 } |
2468 } | |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2469 else if (BOOL_VECTOR_P (seq)) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2470 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2471 for (i = 0; i < leni; i++) |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2472 { |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2473 int byte; |
55161
beac72c0215f
(Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents:
54994
diff
changeset
|
2474 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
|
2475 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
|
2476 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2477 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2478 vals[i] = dummy; |
20992
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2479 } |
d2366423bc00
(mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents:
20928
diff
changeset
|
2480 } |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2481 else if (STRINGP (seq)) |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2482 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2483 int i_byte; |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2484 |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2485 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
|
2486 { |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2487 int c; |
20712
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2488 int i_before = i; |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2489 |
50255c536f0f
(mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents:
20706
diff
changeset
|
2490 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
|
2491 XSETFASTINT (dummy, c); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2492 dummy = call1 (fn, dummy); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2493 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2494 vals[i_before] = dummy; |
20607
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2495 } |
04a436e5760b
(map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents:
20567
diff
changeset
|
2496 } |
211 | 2497 else /* Must be a list, since Flength did not get an error */ |
2498 { | |
2499 tail = seq; | |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
2500 for (i = 0; i < leni && CONSP (tail); i++) |
211 | 2501 { |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
2502 dummy = call1 (fn, XCAR (tail)); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2503 if (vals) |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2504 vals[i] = dummy; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25619
diff
changeset
|
2505 tail = XCDR (tail); |
211 | 2506 } |
2507 } | |
2508 | |
2509 UNGCPRO; | |
2510 } | |
2511 | |
2512 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
|
2513 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
|
2514 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
|
2515 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
|
2516 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
|
2517 (function, sequence, separator) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2518 Lisp_Object function, sequence, separator; |
211 | 2519 { |
2520 Lisp_Object len; | |
2521 register int leni; | |
2522 int nargs; | |
2523 register Lisp_Object *args; | |
2524 register int i; | |
2525 struct gcpro gcpro1; | |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2526 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2527 USE_SAFE_ALLOCA; |
211 | 2528 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2529 len = Flength (sequence); |
89624
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2530 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
|
2531 wrong_type_argument (Qlistp, sequence); |
211 | 2532 leni = XINT (len); |
2533 nargs = leni + leni - 1; | |
81283
f5adf7770714
(Fmapconcat): Use empty_unibyte_string.
Juanma Barranquero <lekktu@gmail.com>
parents:
77908
diff
changeset
|
2534 if (nargs < 0) return empty_unibyte_string; |
211 | 2535 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
2536 SAFE_ALLOCA_LISP (args, nargs); |
211 | 2537 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2538 GCPRO1 (separator); |
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2539 mapcar1 (leni, args, function, sequence); |
211 | 2540 UNGCPRO; |
2541 | |
62950
c698dd8981bd
(mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents:
62674
diff
changeset
|
2542 for (i = leni - 1; i > 0; i--) |
211 | 2543 args[i + i] = args[i]; |
20004 | 2544 |
211 | 2545 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
|
2546 args[i] = separator; |
211 | 2547 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2548 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
|
2549 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2550 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2551 return ret; |
211 | 2552 } |
2553 | |
2554 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
|
2555 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
|
2556 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
|
2557 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
|
2558 (function, sequence) |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2559 Lisp_Object function, sequence; |
211 | 2560 { |
2561 register Lisp_Object len; | |
2562 register int leni; | |
2563 register Lisp_Object *args; | |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2564 Lisp_Object ret; |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2565 USE_SAFE_ALLOCA; |
211 | 2566 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2567 len = Flength (sequence); |
89624
4e86a45294f5
(Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents:
89615
diff
changeset
|
2568 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
|
2569 wrong_type_argument (Qlistp, sequence); |
211 | 2570 leni = XFASTINT (len); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2571 |
56203
2bb92448ff94
(Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents:
56199
diff
changeset
|
2572 SAFE_ALLOCA_LISP (args, leni); |
211 | 2573 |
14091
34911b128a47
(Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents:
14051
diff
changeset
|
2574 mapcar1 (leni, args, function, sequence); |
211 | 2575 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2576 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
|
2577 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2578 |
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
2579 return ret; |
211 | 2580 } |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2581 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2582 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
|
2583 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
|
2584 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
|
2585 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
|
2586 (function, sequence) |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2587 Lisp_Object function, sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2588 { |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2589 register int leni; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2590 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2591 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
|
2592 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
|
2593 wrong_type_argument (Qlistp, sequence); |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2594 mapcar1 (leni, 0, function, sequence); |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2595 |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2596 return sequence; |
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
2597 } |
211 | 2598 |
2599 /* Anything that calls this function must protect from GC! */ | |
2600 | |
2601 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
|
2602 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
|
2603 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
|
2604 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
|
2605 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
|
2606 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
|
2607 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
|
2608 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
|
2609 `recenter', and `quit'.\) |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2610 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2611 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
|
2612 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
|
2613 (prompt) |
211 | 2614 Lisp_Object prompt; |
2615 { | |
25071 | 2616 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
|
2617 register int answer; |
211 | 2618 Lisp_Object xprompt; |
2619 Lisp_Object args[2]; | |
2620 struct gcpro gcpro1, gcpro2; | |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
2621 int count = SPECPDL_INDEX (); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2622 |
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2623 specbind (Qcursor_in_echo_area, Qt); |
211 | 2624 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2625 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
|
2626 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2627 CHECK_STRING (prompt); |
211 | 2628 xprompt = prompt; |
2629 GCPRO2 (prompt, xprompt); | |
2630 | |
93072
e54658ddb618
* w32fns.c (hourglass_timer, hourglass_hwnd): New variables.
Jason Rumney <jasonr@gnu.org>
parents:
91807
diff
changeset
|
2631 #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
|
2632 if (display_hourglass_p) |
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents:
35513
diff
changeset
|
2633 cancel_hourglass (); |
28072
713349e24825
(Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents:
27901
diff
changeset
|
2634 #endif |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
2635 |
211 | 2636 while (1) |
2637 { | |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2638 |
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
|
2639 #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
|
2640 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
|
2641 && (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
|
2642 && 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
|
2643 && 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
|
2644 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2645 Lisp_Object pane, menu; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
2646 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
|
2647 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
|
2648 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
|
2649 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
|
2650 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
|
2651 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
|
2652 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
|
2653 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
|
2654 } |
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
|
2655 #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
|
2656 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
|
2657 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
|
2658 |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2659 { |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2660 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
|
2661 |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
2662 /* 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
|
2663 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
|
2664 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
|
2665 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
|
2666 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
|
2667 args[1] = xprompt; |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2668 Fmessage (2, args); |
0626c87baa01
(Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents:
44219
diff
changeset
|
2669 } |
211 | 2670 |
16561
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2671 if (minibuffer_auto_raise) |
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 Lisp_Object mini_frame; |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2674 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2675 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2676 |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2677 Fraise_frame (mini_frame); |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2678 } |
55fcbbf28987
Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents:
16105
diff
changeset
|
2679 |
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
|
2680 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
|
2681 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
|
2682 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
|
2683 /* 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
|
2684 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
|
2685 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2686 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
|
2687 def = Flookup_key (map, key, Qt); |
211 | 2688 |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2689 if (EQ (def, intern ("skip"))) |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2690 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2691 answer = 0; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2692 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2693 } |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2694 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
|
2695 { |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2696 answer = 1; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2697 break; |
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2698 } |
2311
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2699 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
|
2700 { |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2701 Frecenter (Qnil); |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2702 xprompt = prompt; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2703 continue; |
98b714786ad0
(Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents:
2171
diff
changeset
|
2704 } |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2705 else if (EQ (def, intern ("quit"))) |
211 | 2706 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
|
2707 /* 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
|
2708 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
|
2709 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
|
2710 Vquit_flag = Qt; |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2711 |
211 | 2712 QUIT; |
1194 | 2713 |
2714 /* If we don't clear this, then the next call to read_char will | |
2715 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
|
2716 Vquit_flag = Qnil; |
211 | 2717 |
2718 Fding (Qnil); | |
2719 Fdiscard_input (); | |
2720 if (EQ (xprompt, prompt)) | |
2721 { | |
2722 args[0] = build_string ("Please answer y or n. "); | |
2723 args[1] = prompt; | |
2724 xprompt = Fconcat (2, args); | |
2725 } | |
2726 } | |
2727 UNGCPRO; | |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2728 |
2525
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2729 if (! noninteractive) |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2730 { |
6cf2344e6e7e
(Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents:
2429
diff
changeset
|
2731 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
|
2732 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
|
2733 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
|
2734 } |
2171
4fbceca13b22
* fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents:
2091
diff
changeset
|
2735 |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
2736 unbind_to (count, Qnil); |
2091
eedbad26e34c
(Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents:
1919
diff
changeset
|
2737 return answer ? Qt : Qnil; |
211 | 2738 } |
2739 | |
2740 /* This is how C code calls `yes-or-no-p' and allows the user | |
2741 to redefined it. | |
2742 | |
2743 Anything that calls this function must protect from GC! */ | |
2744 | |
2745 Lisp_Object | |
2746 do_yes_or_no_p (prompt) | |
2747 Lisp_Object prompt; | |
2748 { | |
2749 return call1 (intern ("yes-or-no-p"), prompt); | |
2750 } | |
2751 | |
2752 /* Anything that calls this function must protect from GC! */ | |
2753 | |
2754 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
|
2755 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
|
2756 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
|
2757 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
|
2758 The user must confirm the answer with RET, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2759 and can edit it until it has been confirmed. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2760 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2761 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
|
2762 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
|
2763 (prompt) |
211 | 2764 Lisp_Object prompt; |
2765 { | |
2766 register Lisp_Object ans; | |
2767 Lisp_Object args[2]; | |
2768 struct gcpro gcpro1; | |
2769 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2770 CHECK_STRING (prompt); |
211 | 2771 |
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
|
2772 #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
|
2773 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
|
2774 && (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
|
2775 && 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
|
2776 && 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
|
2777 { |
b2cc63a56415
(Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents:
5664
diff
changeset
|
2778 Lisp_Object pane, menu, obj; |
35336
002c02db42d3
Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents:
34961
diff
changeset
|
2779 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
|
2780 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
|
2781 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
|
2782 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
|
2783 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
|
2784 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
|
2785 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
|
2786 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
|
2787 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
|
2788 } |
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
|
2789 #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
|
2790 |
211 | 2791 args[0] = prompt; |
2792 args[1] = build_string ("(yes or no) "); | |
2793 prompt = Fconcat (2, args); | |
2794 | |
2795 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
|
2796 |
211 | 2797 while (1) |
2798 { | |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
2799 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
|
2800 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
|
2801 Qnil)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2802 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes")) |
211 | 2803 { |
2804 UNGCPRO; | |
2805 return Qt; | |
2806 } | |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
2807 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no")) |
211 | 2808 { |
2809 UNGCPRO; | |
2810 return Qnil; | |
2811 } | |
2812 | |
2813 Fding (Qnil); | |
2814 Fdiscard_input (); | |
2815 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
|
2816 Fsleep_for (make_number (2), Qnil); |
211 | 2817 } |
2818 } | |
2819 | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2820 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
|
2821 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
|
2822 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2823 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
|
2824 to integer. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2825 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2826 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
|
2827 These floats are not multiplied by 100. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2828 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2829 If the 5-minute or 15-minute load averages are not available, return a |
51397 | 2830 shortened list, containing only those averages which are available. |
2831 | |
2832 An error is thrown if the load average can't be obtained. In some | |
2833 cases making it work would require Emacs being installed setuid or | |
2834 setgid so that it can read kernel information, and that usually isn't | |
2835 advisable. */) | |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2836 (use_floats) |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2837 Lisp_Object use_floats; |
211 | 2838 { |
727 | 2839 double load_ave[3]; |
2840 int loads = getloadavg (load_ave, 3); | |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2841 Lisp_Object ret = Qnil; |
211 | 2842 |
727 | 2843 if (loads < 0) |
2844 error ("load-average not implemented for this operating system"); | |
211 | 2845 |
21791
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2846 while (loads-- > 0) |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2847 { |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2848 Lisp_Object load = (NILP (use_floats) ? |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2849 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
|
2850 : make_float (load_ave[loads])); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2851 ret = Fcons (load, ret); |
ec09080bc3e1
(Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents:
21790
diff
changeset
|
2852 } |
211 | 2853 |
727 | 2854 return ret; |
211 | 2855 } |
2856 | |
39968
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
2857 Lisp_Object Vfeatures, Qsubfeatures; |
51a89919bc4e
(Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents:
39956
diff
changeset
|
2858 extern Lisp_Object Vafter_load_alist; |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2859 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2860 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
|
2861 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
|
2862 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2863 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
|
2864 presence or absence of Emacs or environment extensions. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2865 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
|
2866 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
|
2867 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
|
2868 (feature, subfeature) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2869 Lisp_Object feature, subfeature; |
211 | 2870 { |
2871 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
|
2872 CHECK_SYMBOL (feature); |
211 | 2873 tem = Fmemq (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2874 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
|
2875 tem = Fmember (subfeature, Fget (feature, Qsubfeatures)); |
485 | 2876 return (NILP (tem)) ? Qnil : Qt; |
211 | 2877 } |
2878 | |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2879 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
|
2880 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
|
2881 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
|
2882 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
|
2883 (feature, subfeatures) |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2884 Lisp_Object feature, subfeatures; |
211 | 2885 { |
2886 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
|
2887 CHECK_SYMBOL (feature); |
44066
d0bef01f3cb3
(Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents:
41006
diff
changeset
|
2888 CHECK_LIST (subfeatures); |
485 | 2889 if (!NILP (Vautoload_queue)) |
67809
a4fcb45bffec
(Fprovide): Store (0 . OFEATURES) in Vautoload_queue.
Richard M. Stallman <rms@gnu.org>
parents:
67497
diff
changeset
|
2890 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
|
2891 Vautoload_queue); |
211 | 2892 tem = Fmemq (feature, Vfeatures); |
485 | 2893 if (NILP (tem)) |
211 | 2894 Vfeatures = Fcons (feature, Vfeatures); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2895 if (!NILP (subfeatures)) |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2896 Fput (feature, Qsubfeatures, subfeatures); |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
2897 LOADHIST_ATTACH (Fcons (Qprovide, feature)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2898 |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2899 /* Run any load-hooks for this file. */ |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2900 tem = Fassq (feature, Vafter_load_alist); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2901 if (CONSP (tem)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
2902 Fprogn (XCDR (tem)); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
2903 |
211 | 2904 return feature; |
2905 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2906 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2907 /* `require' and its subroutines. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2908 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2909 /* 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
|
2910 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2911 Lisp_Object require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2912 |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
2913 Lisp_Object |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2914 require_unwind (old_value) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2915 Lisp_Object old_value; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2916 { |
40550
56075abda301
(require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents:
40474
diff
changeset
|
2917 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
|
2918 } |
211 | 2919 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2920 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
|
2921 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
|
2922 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
|
2923 is not loaded; so load the file FILENAME. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2924 If FILENAME is omitted, the printname of FEATURE is used as the file name, |
52766 | 2925 and `load' will try to load this name appended with the suffix `.elc' or |
2926 `.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
|
2927 If the optional third argument NOERROR is non-nil, |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
2928 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
|
2929 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
|
2930 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
|
2931 (feature, filename, noerror) |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
2932 Lisp_Object feature, filename, noerror; |
211 | 2933 { |
2934 register Lisp_Object tem; | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2935 struct gcpro gcpro1, gcpro2; |
67497
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2936 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
|
2937 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
2938 CHECK_SYMBOL (feature); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2939 |
59490
dc3b1db0bed2
(Frequire): Record in load-history unconditionally.
Richard M. Stallman <rms@gnu.org>
parents:
59146
diff
changeset
|
2940 /* 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
|
2941 even if the feature specified is already loaded. |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2942 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
|
2943 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
|
2944 if (!from_file) |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2945 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
|
2946 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
|
2947 from_file = 1; |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2948 |
6f5564740da6
(Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents:
66236
diff
changeset
|
2949 if (from_file) |
61417
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2950 { |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2951 tem = Fcons (Qrequire, feature); |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2952 if (NILP (Fmember (tem, Vcurrent_load_list))) |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2953 LOADHIST_ATTACH (tem); |
93f7c57762e3
(Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents:
59630
diff
changeset
|
2954 } |
211 | 2955 tem = Fmemq (feature, Vfeatures); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2956 |
485 | 2957 if (NILP (tem)) |
211 | 2958 { |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46221
diff
changeset
|
2959 int count = SPECPDL_INDEX (); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2960 int nesting = 0; |
45037
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
2961 |
45039 | 2962 /* This is to make sure that loadup.el gives a clear picture |
2963 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
|
2964 if (! NILP (Vpurify_flag)) |
8fe017cea042
(Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents:
44760
diff
changeset
|
2965 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
|
2966 SDATA (SYMBOL_NAME (feature))); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
2967 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2968 /* 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
|
2969 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
|
2970 signal an error. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2971 tem = require_nesting_list; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2972 while (! NILP (tem)) |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2973 { |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2974 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
|
2975 nesting++; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2976 tem = XCDR (tem); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2977 } |
48567
ecf43ac20827
fns.c (Frequire): Change nesting allowance from 2 to 3 to cause more
Steven Tamm <steventamm@mac.com>
parents:
48337
diff
changeset
|
2978 if (nesting > 3) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2979 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
|
2980 SDATA (SYMBOL_NAME (feature))); |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2981 |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2982 /* 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
|
2983 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
|
2984 require_nesting_list = Fcons (feature, require_nesting_list); |
211 | 2985 |
2986 /* Value saved here is to be restored into Vautoload_queue */ | |
2987 record_unwind_protect (un_autoload, Vautoload_queue); | |
2988 Vautoload_queue = Qt; | |
2989 | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2990 /* Load the file. */ |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2991 GCPRO2 (feature, filename); |
37208
34075f64de15
(Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents:
36890
diff
changeset
|
2992 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
|
2993 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
|
2994 UNGCPRO; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
2995 |
23733
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2996 /* If load failed entirely, return nil. */ |
e963fc8ca03f
(Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents:
23690
diff
changeset
|
2997 if (NILP (tem)) |
24016
43344f47a865
(Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents:
23927
diff
changeset
|
2998 return unbind_to (count, Qnil); |
211 | 2999 |
3000 tem = Fmemq (feature, Vfeatures); | |
485 | 3001 if (NILP (tem)) |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3002 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
|
3003 SDATA (SYMBOL_NAME (feature))); |
211 | 3004 |
3005 /* Once loading finishes, don't undo it. */ | |
3006 Vautoload_queue = Qt; | |
3007 feature = unbind_to (count, feature); | |
3008 } | |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
3009 |
211 | 3010 return feature; |
3011 } | |
3012 | |
20004 | 3013 /* Primitives for work of the "widget" library. |
3014 In an ideal world, this section would not have been necessary. | |
3015 However, lisp function calls being as slow as they are, it turns | |
3016 out that some functions in the widget library (wid-edit.el) are the | |
3017 bottleneck of Widget operation. Here is their translation to C, | |
3018 for the sole reason of efficiency. */ | |
3019 | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3020 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
|
3021 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
|
3022 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
|
3023 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3024 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
|
3025 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
|
3026 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
|
3027 (plist, prop) |
20004 | 3028 Lisp_Object plist, prop; |
3029 { | |
3030 while (CONSP (plist) && !EQ (XCAR (plist), prop)) | |
3031 { | |
3032 QUIT; | |
3033 plist = XCDR (plist); | |
3034 plist = CDR (plist); | |
3035 } | |
3036 return plist; | |
3037 } | |
3038 | |
3039 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
|
3040 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
|
3041 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
|
3042 (widget, property, value) |
20004 | 3043 Lisp_Object widget, property, value; |
3044 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3045 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
|
3046 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
|
3047 return value; |
20004 | 3048 } |
3049 | |
3050 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
|
3051 doc: /* In WIDGET, get the value of PROPERTY. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3052 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
|
3053 later with `widget-put'. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3054 (widget, property) |
20004 | 3055 Lisp_Object widget, property; |
3056 { | |
3057 Lisp_Object tmp; | |
3058 | |
3059 while (1) | |
3060 { | |
3061 if (NILP (widget)) | |
3062 return Qnil; | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3063 CHECK_CONS (widget); |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
3064 tmp = Fplist_member (XCDR (widget), property); |
20004 | 3065 if (CONSP (tmp)) |
3066 { | |
3067 tmp = XCDR (tmp); | |
3068 return CAR (tmp); | |
3069 } | |
3070 tmp = XCAR (widget); | |
3071 if (NILP (tmp)) | |
3072 return Qnil; | |
3073 widget = Fget (tmp, Qwidget_type); | |
3074 } | |
3075 } | |
3076 | |
3077 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
|
3078 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
|
3079 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
|
3080 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
|
3081 (nargs, args) |
20004 | 3082 int nargs; |
3083 Lisp_Object *args; | |
3084 { | |
3085 /* This function can GC. */ | |
3086 Lisp_Object newargs[3]; | |
3087 struct gcpro gcpro1, gcpro2; | |
3088 Lisp_Object result; | |
3089 | |
3090 newargs[0] = Fwidget_get (args[0], args[1]); | |
3091 newargs[1] = args[0]; | |
3092 newargs[2] = Flist (nargs - 2, args + 2); | |
3093 GCPRO2 (newargs[0], newargs[2]); | |
3094 result = Fapply (3, newargs); | |
3095 UNGCPRO; | |
3096 return result; | |
3097 } | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3098 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3099 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3100 #include <langinfo.h> |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3101 #endif |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3102 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3103 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
|
3104 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
|
3105 ITEM should be one of the following: |
51397 | 3106 |
49798 | 3107 `codeset', returning the character set as a string (locale item CODESET); |
51397 | 3108 |
49798 | 3109 `days', returning a 7-element vector of day names (locale items DAY_n); |
51397 | 3110 |
49798 | 3111 `months', returning a 12-element vector of month names (locale items MON_n); |
51397 | 3112 |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
3113 `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
|
3114 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
|
3115 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3116 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
|
3117 `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
|
3118 |
49798 | 3119 See also Info node `(libc)Locales'. |
3120 | |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3121 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
|
3122 (item) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3123 Lisp_Object item; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3124 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3125 char *str = NULL; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3126 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3127 Lisp_Object val; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3128 if (EQ (item, Qcodeset)) |
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 str = nl_langinfo (CODESET); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3131 return build_string (str); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3132 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3133 #ifdef DAY_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3134 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
|
3135 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3136 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
|
3137 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
|
3138 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3139 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3140 for (i = 0; i < 7; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3141 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3142 str = nl_langinfo (days[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3143 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
|
3144 /* 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
|
3145 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
|
3146 Faset (v, make_number (i), |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3147 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
|
3148 0)); |
49081
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 return v; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3151 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3152 #endif /* DAY_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3153 #ifdef MON_1 |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3154 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
|
3155 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3156 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
|
3157 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
|
3158 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
|
3159 int i; |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3160 synchronize_system_time_locale (); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3161 for (i = 0; i < 12; i++) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3162 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3163 str = nl_langinfo (months[i]); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3164 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
|
3165 p->contents[i] = |
49915
95557d4395b0
(string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49815
diff
changeset
|
3166 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
|
3167 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3168 XSETVECTOR (val, p); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3169 return val; |
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 #endif /* MON_1 */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3172 /* 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
|
3173 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
|
3174 #ifdef PAPER_WIDTH |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3175 else if (EQ (item, Qpaper)) |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3176 { |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3177 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
|
3178 make_number (nl_langinfo (PAPER_HEIGHT))); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3179 } |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3180 #endif /* PAPER_WIDTH */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3181 #endif /* HAVE_LANGINFO_CODESET*/ |
51397 | 3182 return Qnil; |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
3183 } |
20004 | 3184 |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3185 /* 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
|
3186 Based on code from GNU recode. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3187 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3188 #define MIME_LINE_LENGTH 76 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3189 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3190 #define IS_ASCII(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3191 ((Character) < 128) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3192 #define IS_BASE64(Character) \ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3193 (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
|
3194 #define IS_BASE64_IGNORABLE(Character) \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3195 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3196 || (Character) == '\f' || (Character) == '\r') |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3197 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3198 /* 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
|
3199 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
|
3200 process. */ |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3201 #define READ_QUADRUPLET_BYTE(retval) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3202 do \ |
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 if (i == length) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3205 { \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3206 if (nchars_return) \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3207 *nchars_return = nchars; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3208 return (retval); \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3209 } \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3210 c = from[i++]; \ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3211 } \ |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3212 while (IS_BASE64_IGNORABLE (c)) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3213 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3214 /* 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
|
3215 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
|
3216 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3217 '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
|
3218 '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
|
3219 '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
|
3220 '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
|
3221 '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
|
3222 '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
|
3223 '8', '9', '+', '/' /* 60-63 */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3224 }; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3225 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3226 /* 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
|
3227 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
|
3228 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3229 -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
|
3230 -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
|
3231 -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
|
3232 -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
|
3233 -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
|
3234 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
|
3235 -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
|
3236 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
|
3237 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
|
3238 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
|
3239 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
|
3240 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
|
3241 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
|
3242 }; |
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 /* 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
|
3245 get transformed into four base64 characters. |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3246 |
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 |aaaaaabb| |bbbbcccc| |ccdddddd| |
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 6 2 4 4 2 6 |
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 |00aaaaaa|00bbbbbb|00cccccc|00dddddd| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3253 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3254 |
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 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3257 `--------+--------+--------+--------' |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3258 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3259 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
|
3260 base64 characters. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3261 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3262 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3263 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
|
3264 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
|
3265 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3266 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
|
3267 2, 3, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3268 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
|
3269 Return the length of the encoded text. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3270 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
|
3271 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3272 (beg, end, no_line_break) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3273 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
|
3274 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3275 char *encoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3276 int allength, length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3277 int ibeg, iend, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3278 int old_pos = PT; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3279 USE_SAFE_ALLOCA; |
23208
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 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3282 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3283 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3284 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3285 move_gap_both (XFASTINT (beg), ibeg); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3286 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3287 /* 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
|
3288 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
|
3289 characters, and then we round up. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3290 length = iend - ibeg; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3291 allength = length + length/3 + 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3292 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
|
3293 |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3294 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3295 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
|
3296 NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3297 !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
|
3298 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3299 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3300 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3301 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3302 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3303 /* 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
|
3304 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3305 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
|
3306 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3307 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3308 /* 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
|
3309 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
|
3310 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
|
3311 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
|
3312 SAFE_FREE (); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3313 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
|
3314 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3315 /* 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
|
3316 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
|
3317 if (old_pos >= XFASTINT (end)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3318 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
|
3319 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
|
3320 old_pos = XFASTINT (beg); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3321 SET_PT (old_pos); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3322 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3323 /* 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
|
3324 return make_number (encoded_length); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3325 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3326 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3327 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
|
3328 1, 2, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3329 doc: /* Base64-encode STRING and return the result. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
3330 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
|
3331 into shorter lines. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3332 (string, no_line_break) |
24377
f881dd22ec7d
(Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents:
24334
diff
changeset
|
3333 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
|
3334 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3335 int allength, length, encoded_length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3336 char *encoded; |
23690 | 3337 Lisp_Object encoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3338 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3339 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3340 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3341 |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3342 /* 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
|
3343 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
|
3344 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
|
3345 length = SBYTES (string); |
24437
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3346 allength = length + length/3 + 1; |
8a9d8919ebe8
(Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents:
24377
diff
changeset
|
3347 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
|
3348 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3349 /* 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
|
3350 SAFE_ALLOCA (encoded, char *, allength); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3351 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3352 encoded_length = base64_encode_1 (SDATA (string), |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3353 encoded, length, NILP (no_line_break), |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3354 STRING_MULTIBYTE (string)); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3355 if (encoded_length > allength) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3356 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3357 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3358 if (encoded_length < 0) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3359 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3360 /* 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
|
3361 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3362 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
|
3363 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3364 |
23690 | 3365 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
|
3366 SAFE_FREE (); |
23690 | 3367 |
3368 return encoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3369 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3370 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3371 static int |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3372 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
|
3373 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3374 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3375 int length; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3376 int line_break; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3377 int multibyte; |
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 int counter = 0, i = 0; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3380 char *e = to; |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3381 int c; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3382 unsigned int value; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3383 int bytes; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3384 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3385 while (i < length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3386 { |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3387 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3388 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3389 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
|
3390 if (CHAR_BYTE8_P (c)) |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3391 c = CHAR_TO_BYTE8 (c); |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3392 else if (c >= 256) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3393 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3394 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3395 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3396 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3397 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3398 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3399 /* Wrap line every 76 characters. */ |
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 if (line_break) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3402 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3403 if (counter < MIME_LINE_LENGTH / 4) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3404 counter++; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3405 else |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3406 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3407 *e++ = '\n'; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3408 counter = 1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3409 } |
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 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3412 /* Process first byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3413 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3414 *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
|
3415 value = (0x03 & c) << 4; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3416 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3417 /* Process second byte of a triplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3418 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3419 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3420 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3421 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3422 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3423 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3424 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3425 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3426 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3427 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3428 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3429 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
|
3430 if (CHAR_BYTE8_P (c)) |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3431 c = CHAR_TO_BYTE8 (c); |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3432 else if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3433 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3434 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3435 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3436 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3437 c = from[i++]; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3438 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3439 *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
|
3440 value = (0x0f & c) << 2; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3441 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3442 /* Process third byte of a triplet. */ |
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 if (i == length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3445 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3446 *e++ = base64_value_to_char[value]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3447 *e++ = '='; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3448 break; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3449 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3450 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3451 if (multibyte) |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3452 { |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3453 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
|
3454 if (CHAR_BYTE8_P (c)) |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3455 c = CHAR_TO_BYTE8 (c); |
7a6ebd6b0c38
(base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
89039
diff
changeset
|
3456 else if (c >= 256) |
31865
dd9aa7db6710
(base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents:
31842
diff
changeset
|
3457 return -1; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3458 i += bytes; |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3459 } |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3460 else |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3461 c = from[i++]; |
23208
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 *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
|
3464 *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
|
3465 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3466 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3467 return e - to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3468 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3469 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3470 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3471 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
|
3472 2, 2, "r", |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3473 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
|
3474 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
|
3475 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
|
3476 (beg, end) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3477 Lisp_Object beg, end; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3478 { |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3479 int ibeg, iend, length, allength; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3480 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3481 int old_pos = PT; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3482 int decoded_length; |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3483 int inserted_chars; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3484 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
|
3485 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3486 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3487 validate_region (&beg, &end); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3488 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3489 ibeg = CHAR_TO_BYTE (XFASTINT (beg)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3490 iend = CHAR_TO_BYTE (XFASTINT (end)); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3491 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3492 length = iend - ibeg; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3493 |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3494 /* 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
|
3495 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
|
3496 most two bytes. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3497 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
|
3498 SAFE_ALLOCA (decoded, char *, allength); |
23208
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 move_gap_both (XFASTINT (beg), ibeg); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3501 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
|
3502 multibyte, &inserted_chars); |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3503 if (decoded_length > allength) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3504 abort (); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3505 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3506 if (decoded_length < 0) |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3507 { |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3508 /* 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
|
3509 SAFE_FREE (); |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3510 error ("Invalid base64 data"); |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3511 } |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3512 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3513 /* 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
|
3514 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
|
3515 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3516 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
|
3517 SAFE_FREE (); |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3518 |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3519 /* Delete the original text. */ |
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3520 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
|
3521 iend + decoded_length, 1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3522 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3523 /* 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
|
3524 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
|
3525 if (old_pos >= XFASTINT (end)) |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3526 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
|
3527 else if (old_pos > XFASTINT (beg)) |
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3528 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
|
3529 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
|
3530 |
23536
0154f51c56d8
(Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents:
23453
diff
changeset
|
3531 return make_number (inserted_chars); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3532 } |
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 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
|
3535 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3536 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
|
3537 (string) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3538 Lisp_Object string; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3539 { |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3540 char *decoded; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3541 int length, decoded_length; |
23690 | 3542 Lisp_Object decoded_string; |
56195
3204d2175b6a
* fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents:
56147
diff
changeset
|
3543 USE_SAFE_ALLOCA; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3544 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3545 CHECK_STRING (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3546 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
3547 length = SBYTES (string); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3548 /* 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
|
3549 SAFE_ALLOCA (decoded, char *, length); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3550 |
32753
401f661f11d4
2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
32351
diff
changeset
|
3551 /* 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
|
3552 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
|
3553 0, NULL); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3554 if (decoded_length > length) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3555 abort (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
3556 else if (decoded_length >= 0) |
29010
f62cfa81b0c4
(concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents:
28965
diff
changeset
|
3557 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
|
3558 else |
23901
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3559 decoded_string = Qnil; |
974c8a7b79e8
(Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents:
23877
diff
changeset
|
3560 |
57726
66e97a54985f
Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents:
57482
diff
changeset
|
3561 SAFE_FREE (); |
28493
9ffea423a7b0
(Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents:
28481
diff
changeset
|
3562 if (!STRINGP (decoded_string)) |
32234
811419e9e769
(Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents:
31865
diff
changeset
|
3563 error ("Invalid base64 data"); |
23690 | 3564 |
3565 return decoded_string; | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3566 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3567 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3568 /* 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
|
3569 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
|
3570 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
|
3571 characters in *NCHARS_RETURN. */ |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3572 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3573 static int |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3574 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
|
3575 const char *from; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3576 char *to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3577 int length; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3578 int multibyte; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3579 int *nchars_return; |
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 int i = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3582 char *e = to; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3583 unsigned char c; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3584 unsigned long value; |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3585 int nchars = 0; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3586 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3587 while (1) |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3588 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3589 /* Process first byte of a quadruplet. */ |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3590 |
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3591 READ_QUADRUPLET_BYTE (e-to); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3592 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3593 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3594 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3595 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
|
3596 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3597 /* Process second byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3598 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3599 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3600 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3601 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3602 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3603 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
|
3604 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3605 c = (unsigned char) (value >> 16); |
89039
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3606 if (multibyte && c >= 128) |
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3607 e += BYTE8_STRING (c, e); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3608 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3609 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3610 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3611 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3612 /* 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
|
3613 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3614 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3615 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3616 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3617 { |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3618 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
|
3619 |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3620 if (c != '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3621 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3622 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3623 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3624 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3625 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3626 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3627 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
|
3628 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3629 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
|
3630 if (multibyte && c >= 128) |
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3631 e += BYTE8_STRING (c, e); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3632 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3633 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3634 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3635 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3636 /* Process fourth byte of a quadruplet. */ |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3637 |
24275
e30a84ad7aa0
(IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents:
24255
diff
changeset
|
3638 READ_QUADRUPLET_BYTE (-1); |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3639 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3640 if (c == '=') |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3641 continue; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3642 |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3643 if (!IS_BASE64 (c)) |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3644 return -1; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3645 value |= base64_char_to_value[c]; |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3646 |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3647 c = (unsigned char) (0xff & value); |
89039
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3648 if (multibyte && c >= 128) |
2383f41c7b8a
(base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents:
88980
diff
changeset
|
3649 e += BYTE8_STRING (c, e); |
32351
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3650 else |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3651 *e++ = c; |
4ecfc281cce1
(READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents:
32234
diff
changeset
|
3652 nchars++; |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3653 } |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
3654 } |
25005
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 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3659 ***** ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3660 ***** Hash Tables ***** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3661 ***** ***** |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3664 /* Implemented by gerd@gnu.org. This hash table implementation was |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3665 inspired by CMUCL hash tables. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3666 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3667 /* Ideas: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3668 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3669 1. For small tables, association lists are probably faster than |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3670 hash tables because they have lower overhead. |
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 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
|
3673 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
|
3674 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
|
3675 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
|
3676 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
|
3677 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3678 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3679 /* 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
|
3680 |
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
|
3681 struct Lisp_Hash_Table *weak_hash_tables; |
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 /* Various symbols. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3684 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
3685 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue; |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
3686 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
|
3687 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
|
3688 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3689 /* Function prototypes. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3690 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3691 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
|
3692 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
|
3693 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
|
3694 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
|
3695 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3696 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
|
3697 Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3698 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
|
3699 unsigned, Lisp_Object, unsigned)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3700 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
|
3701 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
|
3702 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
|
3703 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3704 Lisp_Object)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3705 static unsigned sxhash_string P_ ((unsigned char *, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3706 static unsigned sxhash_list P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3707 static unsigned sxhash_vector P_ ((Lisp_Object, int)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3708 static unsigned sxhash_bool_vector P_ ((Lisp_Object)); |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
3709 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
|
3710 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3711 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3712 |
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 Utilities |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3715 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3716 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3717 /* 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
|
3718 Lisp_Hash_Table. Otherwise, signal an error. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3719 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3720 static struct Lisp_Hash_Table * |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3721 check_hash_table (obj) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3722 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3723 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
3724 CHECK_HASH_TABLE (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3725 return XHASH_TABLE (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3726 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3727 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3728 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3729 /* 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
|
3730 number. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3731 |
29979
6fe8f444b6a3
(next_almost_prime): Make it externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
29953
diff
changeset
|
3732 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3733 next_almost_prime (n) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3734 int n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3735 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3736 if (n % 2 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3737 n += 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3738 if (n % 3 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3739 n += 2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3740 if (n % 7 == 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3741 n += 4; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3742 return n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3743 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3744 |
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 /* 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
|
3747 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
|
3748 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
|
3749 -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
|
3750 a DEFUN parameter list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3751 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3752 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3753 get_key_arg (key, nargs, args, used) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3754 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3755 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3756 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3757 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3758 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3759 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
|
3760 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3761 for (i = 0; i < nargs - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3762 if (!used[i] && EQ (args[i], key)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3763 break; |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3764 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3765 if (i >= nargs - 1) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3766 i = -1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3767 else |
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 used[i++] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3770 used[i] = 1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3771 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3772 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3773 return i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3774 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3775 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3776 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3777 /* 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
|
3778 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
|
3779 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
|
3780 |
28481
3caab3235bc1
(larger_vector): Make externally visible.
Gerd Moellmann <gerd@gnu.org>
parents:
28222
diff
changeset
|
3781 Lisp_Object |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3782 larger_vector (vec, new_size, init) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3783 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3784 int new_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3785 Lisp_Object init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3786 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3787 struct Lisp_Vector *v; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3788 int i, old_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3789 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3790 xassert (VECTORP (vec)); |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
3791 old_size = ASIZE (vec); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3792 xassert (new_size >= old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3793 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3794 v = allocate_vector (new_size); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3795 bcopy (XVECTOR (vec)->contents, v->contents, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3796 old_size * sizeof *v->contents); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3797 for (i = old_size; i < new_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3798 v->contents[i] = init; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3799 XSETVECTOR (vec, v); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3800 return vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3801 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3802 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3803 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3804 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3805 Low-level Functions |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3806 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3807 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3808 /* 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
|
3809 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
|
3810 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3811 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3812 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3813 cmpfn_eql (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3814 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3815 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3816 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3817 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3818 return (FLOATP (key1) |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3819 && FLOATP (key2) |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
3820 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2)); |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3823 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3824 /* 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
|
3825 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
|
3826 KEY2 are the same. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3827 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3828 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3829 cmpfn_equal (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3830 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3831 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3832 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3833 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3834 return hash1 == hash2 && !NILP (Fequal (key1, key2)); |
25005
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 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
3837 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3838 /* 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
|
3839 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
|
3840 if KEY1 and KEY2 are the same. */ |
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 static int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3843 cmpfn_user_defined (h, key1, hash1, key2, hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3844 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3845 Lisp_Object key1, key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3846 unsigned hash1, hash2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3847 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3848 if (hash1 == hash2) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3849 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3850 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
|
3851 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3852 args[0] = h->user_cmp_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3853 args[1] = key1; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3854 args[2] = key2; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3855 return !NILP (Ffuncall (3, args)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3856 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3857 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3858 return 0; |
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3861 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3862 /* 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
|
3863 `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
|
3864 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3865 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3866 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3867 hashfn_eq (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3868 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3869 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3870 { |
90970
3371fc48749b
Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
90918
diff
changeset
|
3871 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
|
3872 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3873 return hash; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3874 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3875 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3876 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3877 /* 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
|
3878 `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
|
3879 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3880 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3881 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3882 hashfn_eql (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3883 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3884 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3885 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3886 unsigned hash; |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3887 if (FLOATP (key)) |
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3888 hash = sxhash (key, 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3889 else |
90970
3371fc48749b
Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
90918
diff
changeset
|
3890 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
|
3891 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3892 return hash; |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3895 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3896 /* 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
|
3897 `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
|
3898 in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3899 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3900 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3901 hashfn_equal (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3902 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3903 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3904 { |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3905 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
|
3906 xassert ((hash & ~INTMASK) == 0); |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
3907 return hash; |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3910 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3911 /* 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
|
3912 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
|
3913 guaranteed to fit in a Lisp integer. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3914 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3915 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3916 hashfn_user_defined (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3917 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3918 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3919 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3920 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
|
3921 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3922 args[0] = h->user_hash_function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3923 args[1] = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3924 hash = Ffuncall (2, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3925 if (!INTEGERP (hash)) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
3926 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
|
3927 return XUINT (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3928 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3929 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3930 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3931 /* Create and initialize a new hash table. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3932 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3933 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
|
3934 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
|
3935 `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
|
3936 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
|
3937 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3938 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
|
3939 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3940 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
|
3941 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
|
3942 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
|
3943 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
|
3944 REHASH_SIZE. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3945 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3946 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
|
3947 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
|
3948 (table size) is >= REHASH_THRESHOLD. |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3949 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3950 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
|
3951 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
|
3952 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3953 Lisp_Object |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3954 make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3955 user_test, user_hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3956 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3957 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3958 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3959 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3960 Lisp_Object table; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3961 int index_size, i, sz; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3962 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3963 /* Preconditions. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3964 xassert (SYMBOLP (test)); |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3965 xassert (INTEGERP (size) && XINT (size) >= 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3966 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3967 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3968 xassert (FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3969 && XFLOATINT (rehash_threshold) > 0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3970 && XFLOATINT (rehash_threshold) <= 1.0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3971 |
30602
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3972 if (XFASTINT (size) == 0) |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3973 size = make_number (1); |
4f195cb24338
Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents:
30597
diff
changeset
|
3974 |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3975 /* Allocate a table and initialize it. */ |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
3976 h = allocate_hash_table (); |
25005
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 /* Initialize hash table slots. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3979 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
|
3980 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3981 h->test = test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3982 if (EQ (test, Qeql)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3983 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3984 h->cmpfn = cmpfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3985 h->hashfn = hashfn_eql; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3986 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3987 else if (EQ (test, Qeq)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3988 { |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
3989 h->cmpfn = NULL; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3990 h->hashfn = hashfn_eq; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3991 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3992 else if (EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3993 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3994 h->cmpfn = cmpfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3995 h->hashfn = hashfn_equal; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3996 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3997 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3998 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
3999 h->user_cmp_function = user_test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4000 h->user_hash_function = user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4001 h->cmpfn = cmpfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4002 h->hashfn = hashfn_user_defined; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4003 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4004 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4005 h->weak = weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4006 h->rehash_threshold = rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4007 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
|
4008 h->count = 0; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4009 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
|
4010 h->hash = Fmake_vector (size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4011 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
|
4012 /* 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
|
4013 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
|
4014 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4015 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4016 /* Set up the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4017 for (i = 0; i < sz - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4018 HASH_NEXT (h, i) = make_number (i + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4019 h->next_free = make_number (0); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4020 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4021 XSET_HASH_TABLE (table, h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4022 xassert (HASH_TABLE_P (table)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4023 xassert (XHASH_TABLE (table) == h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4024 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4025 /* 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
|
4026 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
|
4027 h->next_weak = NULL; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4028 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4029 { |
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
|
4030 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
|
4031 weak_hash_tables = h; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4032 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4033 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4034 return table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4035 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4036 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4037 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4038 /* 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
|
4039 only the table itself is. */ |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4040 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4041 Lisp_Object |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4042 copy_hash_table (h1) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4043 struct Lisp_Hash_Table *h1; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4044 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4045 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4046 struct Lisp_Hash_Table *h2; |
40769
fa1546836808
(copy_hash_table): Remove unused variable `v'.
Pavel Janík <Pavel@Janik.cz>
parents:
40734
diff
changeset
|
4047 struct Lisp_Vector *next; |
36431
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4048 |
c10e67afd7ec
(Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents:
36256
diff
changeset
|
4049 h2 = allocate_hash_table (); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4050 next = h2->vec_next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4051 bcopy (h1, h2, sizeof *h2); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4052 h2->vec_next = next; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4053 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
|
4054 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
|
4055 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
|
4056 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
|
4057 XSET_HASH_TABLE (table, h2); |
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 /* 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
|
4060 if (!NILP (h2->weak)) |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4061 { |
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
|
4062 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
|
4063 weak_hash_tables = h2; |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4064 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4065 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4066 return table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4067 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4068 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4069 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4070 /* 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
|
4071 because it's already too large, throw an error. */ |
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 static INLINE void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4074 maybe_resize_hash_table (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4075 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4076 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4077 if (NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4078 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4079 int old_size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4080 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
|
4081 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
|
4082 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4083 if (INTEGERP (h->rehash_size)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4084 new_size = old_size + XFASTINT (h->rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4085 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4086 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
|
4087 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
|
4088 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
|
4089 (new_size |
88aa46c9dfde
(make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents:
29232
diff
changeset
|
4090 / 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
|
4091 /* 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
|
4092 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
|
4093 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
|
4094 if (nsize > MOST_POSITIVE_FIXNUM) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4095 error ("Hash table too large to resize"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4096 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4097 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
|
4098 h->next = larger_vector (h->next, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4099 h->hash = larger_vector (h->hash, new_size, Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4100 h->index = Fmake_vector (make_number (index_size), Qnil); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4101 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4102 /* 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
|
4103 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
|
4104 maphash faster. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4105 for (i = old_size; i < new_size - 1; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4106 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
|
4107 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4108 if (!NILP (h->next_free)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4109 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4110 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
|
4111 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4112 last = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4113 while (next = HASH_NEXT (h, XFASTINT (last)), |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4114 !NILP (next)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4115 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
|
4116 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4117 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4118 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4119 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4120 XSETFASTINT (h->next_free, old_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4121 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4122 /* Rehash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4123 for (i = 0; i < old_size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4124 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4125 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4126 unsigned hash_code = XUINT (HASH_HASH (h, i)); |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4127 int start_of_bucket = hash_code % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4128 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4129 HASH_INDEX (h, start_of_bucket) = make_number (i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4130 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4131 } |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4134 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4135 /* 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
|
4136 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
|
4137 matching KEY, or -1 if not found. */ |
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 int |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4140 hash_lookup (h, key, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4141 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4142 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4143 unsigned *hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4144 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4145 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4146 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4147 Lisp_Object idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4148 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4149 hash_code = h->hashfn (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4150 if (hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4151 *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
|
4152 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4153 start_of_bucket = hash_code % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4154 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4155 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4156 /* 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
|
4157 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4158 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4159 int i = XFASTINT (idx); |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4160 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
|
4161 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4162 && 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
|
4163 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4164 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4165 idx = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4166 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4167 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4168 return NILP (idx) ? -1 : XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4169 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4170 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4171 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4172 /* 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
|
4173 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
|
4174 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
|
4175 |
c629af522c09
(Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents:
26596
diff
changeset
|
4176 int |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4177 hash_put (h, key, value, hash) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4178 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4179 Lisp_Object key, value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4180 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4181 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4182 int start_of_bucket, i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4183 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4184 xassert ((hash & ~INTMASK) == 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4185 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4186 /* Increment count after resizing because resizing may fail. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4187 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
|
4188 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
|
4189 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4190 /* Store key/value in the key_and_value vector. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4191 i = XFASTINT (h->next_free); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4192 h->next_free = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4193 HASH_KEY (h, i) = key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4194 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4195 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4196 /* Remember its hash code. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4197 HASH_HASH (h, i) = make_number (hash); |
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 /* Add new entry to its collision chain. */ |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4200 start_of_bucket = hash % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4201 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4202 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
|
4203 return i; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4204 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4205 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4206 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4207 /* 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
|
4208 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4209 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4210 hash_remove (h, key) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4211 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4212 Lisp_Object key; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4213 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4214 unsigned hash_code; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4215 int start_of_bucket; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4216 Lisp_Object idx, prev; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4217 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4218 hash_code = h->hashfn (h, key); |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4219 start_of_bucket = hash_code % ASIZE (h->index); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4220 idx = HASH_INDEX (h, start_of_bucket); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4221 prev = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4222 |
28555
976bc44944da
(mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents:
28507
diff
changeset
|
4223 /* 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
|
4224 while (!NILP (idx)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4225 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4226 int i = XFASTINT (idx); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4227 |
25349
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4228 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
|
4229 || (h->cmpfn |
ee30c32ea191
(hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents:
25149
diff
changeset
|
4230 && 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
|
4231 HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) |
25005
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 /* Take entry out of collision chain. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4234 if (NILP (prev)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4235 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4236 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4237 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4238 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4239 /* 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
|
4240 the free list. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4241 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
|
4242 HASH_NEXT (h, i) = h->next_free; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4243 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
|
4244 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
|
4245 xassert (h->count >= 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4246 break; |
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 else |
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 prev = idx; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4251 idx = HASH_NEXT (h, i); |
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 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4254 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4255 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4256 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4257 /* Clear hash table H. */ |
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 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4260 hash_clear (h) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4261 struct Lisp_Hash_Table *h; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4262 { |
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
|
4263 if (h->count > 0) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4264 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4265 int i, size = HASH_TABLE_SIZE (h); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4266 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4267 for (i = 0; i < size; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4268 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4269 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
|
4270 HASH_KEY (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4271 HASH_VALUE (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4272 HASH_HASH (h, i) = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4273 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4274 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4275 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
|
4276 ASET (h->index, i, Qnil); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4277 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4278 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
|
4279 h->count = 0; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4280 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4281 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4282 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4283 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4284 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4285 /************************************************************************ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4286 Weak Hash Tables |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4287 ************************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4288 |
94992
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4289 void |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4290 init_weak_hash_tables () |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4291 { |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4292 weak_hash_tables = NULL; |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4293 } |
05fbecb52ee0
(init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents:
94963
diff
changeset
|
4294 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4295 /* 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
|
4296 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
|
4297 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
|
4298 non-zero if anything was marked. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4299 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4300 static int |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4301 sweep_weak_table (h, remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4302 struct Lisp_Hash_Table *h; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4303 int remove_entries_p; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4304 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4305 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
|
4306 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4307 n = ASIZE (h->index) & ~ARRAY_MARK_FLAG; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4308 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
|
4309 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4310 for (bucket = 0; bucket < n; ++bucket) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4311 { |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4312 Lisp_Object idx, next, prev; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4313 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4314 /* Follow collision chain, removing entries that |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4315 don't survive this garbage collection. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4316 prev = Qnil; |
90970
3371fc48749b
Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
90918
diff
changeset
|
4317 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
|
4318 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4319 int i = XFASTINT (idx); |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4320 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
|
4321 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
|
4322 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
|
4323 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4324 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
|
4325 remove_p = !key_known_to_survive_p; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4326 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
|
4327 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
|
4328 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
|
4329 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
|
4330 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
|
4331 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
|
4332 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4333 abort (); |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4334 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4335 next = HASH_NEXT (h, i); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4336 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4337 if (remove_entries_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4338 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4339 if (remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4340 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4341 /* 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
|
4342 if (NILP (prev)) |
35513
0fbf1517a670
(sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents:
35479
diff
changeset
|
4343 HASH_INDEX (h, bucket) = next; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4344 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4345 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
|
4346 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4347 /* Add to free list. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4348 HASH_NEXT (h, i) = h->next_free; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4349 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
|
4350 |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4351 /* Clear key, value, and hash. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4352 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4353 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
|
4354 |
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
|
4355 h->count--; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4356 } |
59630
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4357 else |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4358 { |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4359 prev = idx; |
e35417abe6a6
(sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents:
59490
diff
changeset
|
4360 } |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4361 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4362 else |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4363 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4364 if (!remove_p) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4365 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4366 /* 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
|
4367 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
|
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_KEY (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 } |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4372 |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4373 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
|
4374 { |
51768
31f2f6a2df06
(sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51397
diff
changeset
|
4375 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
|
4376 marked = 1; |
d9c85e2f07ba
(sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents:
29991
diff
changeset
|
4377 } |
27530
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 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4380 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4381 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4382 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4383 return marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4384 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4385 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4386 /* 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
|
4387 current garbage collection. Remove weak tables that don't survive |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4388 from Vweak_hash_tables. Called from gc_sweep. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4389 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4390 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4391 sweep_weak_hash_tables () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4392 { |
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
|
4393 struct Lisp_Hash_Table *h, *used, *next; |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4394 int marked; |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4395 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4396 /* 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
|
4397 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
|
4398 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
|
4399 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
|
4400 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
|
4401 one finds that it shouldn't. */ |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4402 do |
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 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
|
4405 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
|
4406 { |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4407 if (h->size & ARRAY_MARK_FLAG) |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4408 marked |= sweep_weak_table (h, 0); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4409 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4410 } |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4411 while (marked); |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4412 |
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4413 /* 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
|
4414 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
|
4415 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4416 next = h->next_weak; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4417 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4418 if (h->size & ARRAY_MARK_FLAG) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4419 { |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4420 /* 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
|
4421 if (h->count > 0) |
27530
774df97ad330
(sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
26856
diff
changeset
|
4422 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
|
4423 |
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4424 /* 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
|
4425 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
|
4426 used = h; |
25005
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 } |
30634
d833a6450e10
(sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents:
30602
diff
changeset
|
4429 |
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
|
4430 weak_hash_tables = used; |
25005
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 |
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 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4436 Hash Code Computation |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4437 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4438 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4439 /* Maximum depth up to which to dive into Lisp structures. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4440 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4441 #define SXHASH_MAX_DEPTH 3 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4442 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4443 /* 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
|
4444 account. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4445 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4446 #define SXHASH_MAX_LEN 7 |
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 /* Combine two integers X and Y for hashing. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4449 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4450 #define SXHASH_COMBINE(X, Y) \ |
25709
ba4e2a641663
(SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents:
25690
diff
changeset
|
4451 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4452 + (unsigned)(Y)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4453 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4454 |
30760
c5077abd4ef2
(hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents:
30637
diff
changeset
|
4455 /* 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
|
4456 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
|
4457 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4458 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4459 sxhash_string (ptr, len) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4460 unsigned char *ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4461 int len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4462 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4463 unsigned char *p = ptr; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4464 unsigned char *end = p + len; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4465 unsigned char c; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4466 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4467 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4468 while (p != end) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4469 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4470 c = *p++; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4471 if (c >= 0140) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4472 c -= 40; |
72511
1ef51160f403
(sxhash_string): Rotate properly; don't lose bits.
Richard M. Stallman <rms@gnu.org>
parents:
72136
diff
changeset
|
4473 hash = ((hash << 4) + (hash >> 28) + c); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4474 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4475 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4476 return hash & INTMASK; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4477 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4478 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4479 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4480 /* 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
|
4481 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
|
4482 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4483 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4484 sxhash_list (list, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4485 Lisp_Object list; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4486 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4487 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4488 unsigned hash = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4489 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
|
4490 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4491 if (depth < SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4492 for (i = 0; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4493 CONSP (list) && i < SXHASH_MAX_LEN; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4494 list = XCDR (list), ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4495 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4496 unsigned hash2 = sxhash (XCAR (list), depth + 1); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4497 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4498 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4499 |
69655
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4500 if (!NILP (list)) |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4501 { |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4502 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
|
4503 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
|
4504 } |
b1e3b0da5945
(sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
4505 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4506 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4507 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4508 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4509 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4510 /* 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
|
4511 the Lisp structure. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4512 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4513 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4514 sxhash_vector (vec, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4515 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4516 int depth; |
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 hash = ASIZE (vec); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4519 int i, n; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4520 |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4521 n = min (SXHASH_MAX_LEN, ASIZE (vec)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4522 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4523 { |
74163
f7736a8bd079
Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
74101
diff
changeset
|
4524 unsigned hash2 = sxhash (AREF (vec, i), depth + 1); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4525 hash = SXHASH_COMBINE (hash, hash2); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4526 } |
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 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4529 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4530 |
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 /* Return a hash for bool-vector VECTOR. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4533 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4534 static unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4535 sxhash_bool_vector (vec) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4536 Lisp_Object vec; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4537 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4538 unsigned hash = XBOOL_VECTOR (vec)->size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4539 int i, n; |
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 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4542 for (i = 0; i < n; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4543 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4544 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4545 return hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4546 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4547 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4548 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4549 /* 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
|
4550 structure. Value is an unsigned integer clipped to INTMASK. */ |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4551 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4552 unsigned |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4553 sxhash (obj, depth) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4554 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4555 int depth; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4556 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4557 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4558 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4559 if (depth > SXHASH_MAX_DEPTH) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4560 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
|
4561 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4562 switch (XTYPE (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4563 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4564 case Lisp_Int: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4565 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4566 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4567 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4568 case Lisp_Misc: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4569 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4570 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4571 |
57988
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4572 case Lisp_Symbol: |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4573 obj = SYMBOL_NAME (obj); |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4574 /* Fall through. */ |
75429b9aa2f2
(sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents:
57726
diff
changeset
|
4575 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4576 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
|
4577 hash = sxhash_string (SDATA (obj), SCHARS (obj)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4578 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4579 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4580 /* This can be everything from a vector to an overlay. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4581 case Lisp_Vectorlike: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4582 if (VECTORP (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4583 /* 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
|
4584 they are `eq', except for strings and bit-vectors. In |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4585 Emacs, this works differently. We have to compare element |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4586 by element. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4587 hash = sxhash_vector (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4588 else if (BOOL_VECTOR_P (obj)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4589 hash = sxhash_bool_vector (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4590 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4591 /* 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
|
4592 address as hash. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4593 hash = XUINT (obj); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4594 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4595 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4596 case Lisp_Cons: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4597 hash = sxhash_list (obj, depth); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4598 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4599 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4600 case Lisp_Float: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4601 { |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4602 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
|
4603 unsigned char *e = p + sizeof XFLOAT_DATA (obj); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4604 for (hash = 0; p < e; ++p) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4605 hash = SXHASH_COMBINE (hash, *p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4606 break; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4607 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4608 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4609 default: |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4610 abort (); |
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 |
53090
86e42266b65e
(hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
53042
diff
changeset
|
4613 return hash & INTMASK; |
25005
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 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4618 /*********************************************************************** |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4619 Lisp Interface |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4620 ***********************************************************************/ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4621 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4622 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4623 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
|
4624 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
|
4625 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4626 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4627 { |
77908
e5fb6472b6db
(Fsxhash): Delete stray semicolon.
Chong Yidong <cyd@stupidchicken.com>
parents:
75348
diff
changeset
|
4628 unsigned hash = sxhash (obj, 0); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4629 return make_number (hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4630 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4631 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4632 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4633 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
|
4634 doc: /* Create and return a new hash table. |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4635 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4636 Arguments are specified as keyword/argument pairs. The following |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4637 arguments are defined: |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4638 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4639 :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
|
4640 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
|
4641 `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
|
4642 `define-hash-table-test'. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4643 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4644 :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
|
4645 Default is 65. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4646 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4647 :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
|
4648 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
|
4649 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
|
4650 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
|
4651 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4652 :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
|
4653 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
|
4654 table. Default is 0.8. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4655 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4656 :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
|
4657 `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
|
4658 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
|
4659 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
|
4660 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
|
4661 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
|
4662 is nil. |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
4663 |
75fe73bea452
(Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents:
39977
diff
changeset
|
4664 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
|
4665 (nargs, args) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4666 int nargs; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4667 Lisp_Object *args; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4668 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4669 Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4670 Lisp_Object user_test, user_hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4671 char *used; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4672 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4673 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4674 /* 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
|
4675 have been consumed. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4676 used = (char *) alloca (nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4677 bzero (used, nargs * sizeof *used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4678 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4679 /* See if there's a `:test TEST' among the arguments. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4680 i = get_key_arg (QCtest, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4681 test = i < 0 ? Qeql : args[i]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4682 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4683 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4684 /* See if it is a user-defined test. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4685 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
|
4686 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4687 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
|
4688 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
|
4689 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
|
4690 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
|
4691 user_hash = XCAR (XCDR (prop)); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4692 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4693 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4694 user_test = user_hash = Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4695 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4696 /* See if there's a `:size SIZE' argument. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4697 i = get_key_arg (QCsize, nargs, args, used); |
46221
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4698 size = i < 0 ? Qnil : args[i]; |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4699 if (NILP (size)) |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4700 size = make_number (DEFAULT_HASH_SIZE); |
2f81e2382d8d
(Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45650
diff
changeset
|
4701 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
|
4702 signal_error ("Invalid hash table size", size); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4703 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4704 /* Look for `:rehash-size SIZE'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4705 i = get_key_arg (QCrehash_size, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4706 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
|
4707 if (!NUMBERP (rehash_size) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4708 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4709 || XFLOATINT (rehash_size) <= 1.0) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4710 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
|
4711 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4712 /* Look for `:rehash-threshold THRESHOLD'. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4713 i = get_key_arg (QCrehash_threshold, nargs, args, used); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4714 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
|
4715 if (!FLOATP (rehash_threshold) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4716 || XFLOATINT (rehash_threshold) <= 0.0 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4717 || XFLOATINT (rehash_threshold) > 1.0) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4718 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
|
4719 |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
4720 /* Look for `:weakness WEAK'. */ |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
4721 i = get_key_arg (QCweakness, nargs, args, used); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4722 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
|
4723 if (EQ (weak, Qt)) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4724 weak = Qkey_and_value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4725 if (!NILP (weak) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4726 && !EQ (weak, Qkey) |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4727 && !EQ (weak, Qvalue) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4728 && !EQ (weak, Qkey_or_value) |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
4729 && !EQ (weak, Qkey_and_value)) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4730 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
|
4731 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4732 /* 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
|
4733 for (i = 0; i < nargs; ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4734 if (!used[i]) |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4735 signal_error ("Invalid argument list", args[i]); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4736 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4737 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
|
4738 user_test, user_hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4739 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4740 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4741 |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4742 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
|
4743 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
|
4744 (table) |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4745 Lisp_Object table; |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4746 { |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4747 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
|
4748 } |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4749 |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
4750 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4751 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
|
4752 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
|
4753 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4754 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4755 { |
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
|
4756 return make_number (check_hash_table (table)->count); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4757 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4758 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4759 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4760 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4761 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
|
4762 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
|
4763 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4764 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4765 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4766 return check_hash_table (table)->rehash_size; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4767 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4768 |
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 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4771 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
|
4772 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
|
4773 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4774 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4775 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4776 return check_hash_table (table)->rehash_threshold; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4777 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4778 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4779 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4780 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
|
4781 doc: /* Return the size of TABLE. |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4782 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
|
4783 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
|
4784 without need for resizing. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4785 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4786 Lisp_Object table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4787 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4788 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4789 return make_number (HASH_TABLE_SIZE (h)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4790 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4791 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4792 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4793 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
|
4794 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
|
4795 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4796 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4797 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4798 return check_hash_table (table)->test; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4799 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4800 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4801 |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
4802 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
|
4803 1, 1, 0, |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4804 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
|
4805 (table) |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4806 Lisp_Object table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4807 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4808 return check_hash_table (table)->weak; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4809 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4810 |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4811 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4812 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
|
4813 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
|
4814 (obj) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4815 Lisp_Object obj; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4816 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4817 return HASH_TABLE_P (obj) ? Qt : Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4818 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4819 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4820 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4821 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, |
87961
868797e785eb
(Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
87903
diff
changeset
|
4822 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
|
4823 (table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4824 Lisp_Object table; |
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 hash_clear (check_hash_table (table)); |
87961
868797e785eb
(Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
87903
diff
changeset
|
4827 /* Be compatible with XEmacs. */ |
868797e785eb
(Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
87903
diff
changeset
|
4828 return table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4829 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4830 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4831 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4832 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
|
4833 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
|
4834 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
|
4835 (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
|
4836 Lisp_Object key, table, dflt; |
25005
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 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4839 int i = hash_lookup (h, key, NULL); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4840 return i >= 0 ? HASH_VALUE (h, i) : dflt; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4841 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4842 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4843 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4844 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
|
4845 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
|
4846 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
|
4847 VALUE. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4848 (key, value, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4849 Lisp_Object key, value, table; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4850 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4851 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4852 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4853 unsigned hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4854 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4855 i = hash_lookup (h, key, &hash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4856 if (i >= 0) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4857 HASH_VALUE (h, i) = value; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4858 else |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4859 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
|
4860 |
29991
fff5fd809d11
(Fputhash): Return `value' rather than nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29979
diff
changeset
|
4861 return value; |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4862 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4863 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4864 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4865 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
|
4866 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
|
4867 (key, table) |
25080
46c21258f1ff
(Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents:
25071
diff
changeset
|
4868 Lisp_Object key, table; |
25005
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 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4871 hash_remove (h, key); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4872 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4873 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4874 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4875 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4876 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
|
4877 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
|
4878 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
|
4879 (function, table) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4880 Lisp_Object function, table; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4881 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4882 struct Lisp_Hash_Table *h = check_hash_table (table); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4883 Lisp_Object args[3]; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4884 int i; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4885 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4886 for (i = 0; i < HASH_TABLE_SIZE (h); ++i) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4887 if (!NILP (HASH_HASH (h, i))) |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4888 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4889 args[0] = function; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4890 args[1] = HASH_KEY (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4891 args[2] = HASH_VALUE (h, i); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4892 Ffuncall (3, args); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4893 } |
30597
2cb00e0bf8d5
(Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents:
30510
diff
changeset
|
4894 |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4895 return Qnil; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4896 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4897 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4898 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4899 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4900 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
|
4901 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
|
4902 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4903 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
|
4904 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
|
4905 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4906 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
|
4907 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
|
4908 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
|
4909 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
|
4910 including negative integers. */) |
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4911 (name, test, hash) |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4912 Lisp_Object name, test, hash; |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4913 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4914 return Fput (name, Qhash_table_test, list2 (test, hash)); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4915 } |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
4916 |
28965 | 4917 |
34050 | 4918 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4919 /************************************************************************ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4920 MD5 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4921 ************************************************************************/ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4922 |
34050 | 4923 #include "md5.h" |
4924 | |
4925 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
|
4926 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
|
4927 |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4928 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
|
4929 algorithm to calculate it is defined in RFC 1321. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4930 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4931 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
|
4932 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
|
4933 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
|
4934 OBJECT. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4935 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4936 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
|
4937 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
|
4938 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
|
4939 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
|
4940 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
|
4941 file. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4942 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4943 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
|
4944 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
|
4945 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
|
4946 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4947 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
|
4948 command `prefer-coding-system') is used. |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4949 |
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
4950 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
|
4951 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
|
4952 (object, start, end, coding_system, noerror) |
34050 | 4953 Lisp_Object object, start, end, coding_system, noerror; |
4954 { | |
4955 unsigned char digest[16]; | |
4956 unsigned char value[33]; | |
4957 int i; | |
4958 int size; | |
4959 int size_byte = 0; | |
4960 int start_char = 0, end_char = 0; | |
4961 int start_byte = 0, end_byte = 0; | |
4962 register int b, e; | |
4963 register struct buffer *bp; | |
4964 int temp; | |
4965 | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4966 if (STRINGP (object)) |
34050 | 4967 { |
4968 if (NILP (coding_system)) | |
4969 { | |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4970 /* 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
|
4971 |
34050 | 4972 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
|
4973 /* 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
|
4974 coding_system = preferred_coding_system (); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4975 else |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4976 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4977 } |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4978 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4979 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
|
4980 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4981 /* Invalid coding system. */ |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
4982 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4983 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4984 coding_system = Qraw_text; |
34050 | 4985 else |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
4986 xsignal1 (Qcoding_system_error, coding_system); |
34050 | 4987 } |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4988 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
4989 if (STRING_MULTIBYTE (object)) |
88375
38cab5bfa62b
Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents:
41006
diff
changeset
|
4990 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); |
34050 | 4991 |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46293
diff
changeset
|
4992 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
|
4993 size_byte = SBYTES (object); |
34050 | 4994 |
4995 if (!NILP (start)) | |
4996 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
4997 CHECK_NUMBER (start); |
34050 | 4998 |
4999 start_char = XINT (start); | |
5000 | |
5001 if (start_char < 0) | |
5002 start_char += size; | |
5003 | |
5004 start_byte = string_char_to_byte (object, start_char); | |
5005 } | |
5006 | |
5007 if (NILP (end)) | |
5008 { | |
5009 end_char = size; | |
5010 end_byte = size_byte; | |
5011 } | |
5012 else | |
5013 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5014 CHECK_NUMBER (end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5015 |
34050 | 5016 end_char = XINT (end); |
5017 | |
5018 if (end_char < 0) | |
5019 end_char += size; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5020 |
34050 | 5021 end_byte = string_char_to_byte (object, end_char); |
5022 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5023 |
34050 | 5024 if (!(0 <= start_char && start_char <= end_char && end_char <= size)) |
5025 args_out_of_range_3 (object, make_number (start_char), | |
5026 make_number (end_char)); | |
5027 } | |
5028 else | |
5029 { | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5030 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
|
5031 |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5032 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
|
5033 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5034 CHECK_BUFFER (object); |
34050 | 5035 |
5036 bp = XBUFFER (object); | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5037 if (bp != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5038 set_buffer_internal (bp); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5039 |
34050 | 5040 if (NILP (start)) |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5041 b = BEGV; |
34050 | 5042 else |
5043 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5044 CHECK_NUMBER_COERCE_MARKER (start); |
34050 | 5045 b = XINT (start); |
5046 } | |
5047 | |
5048 if (NILP (end)) | |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5049 e = ZV; |
34050 | 5050 else |
5051 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40550
diff
changeset
|
5052 CHECK_NUMBER_COERCE_MARKER (end); |
34050 | 5053 e = XINT (end); |
5054 } | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5055 |
34050 | 5056 if (b > e) |
5057 temp = b, b = e, e = temp; | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5058 |
53681
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5059 if (!(BEGV <= b && e <= ZV)) |
34050 | 5060 args_out_of_range (start, end); |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5061 |
34050 | 5062 if (NILP (coding_system)) |
5063 { | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5064 /* 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
|
5065 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
|
5066 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5067 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
|
5068 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
|
5069 else |
34050 | 5070 { |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5071 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
|
5072 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5073 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
|
5074 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5075 || 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
|
5076 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5077 coding_system = Qnil; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5078 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
|
5079 force_raw_text = 1; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5080 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5081 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5082 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
|
5083 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5084 /* 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
|
5085 Lisp_Object args[4], val; |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5086 |
34106
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5087 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
|
5088 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
|
5089 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
|
5090 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
|
5091 coding_system = XCDR (val); |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5092 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5093 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5094 if (NILP (coding_system) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5095 && !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
|
5096 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5097 /* 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
|
5098 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
|
5099 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
|
5100 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5101 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5102 if (!force_raw_text |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5103 && !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
|
5104 /* 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
|
5105 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
|
5106 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
|
5107 coding_system, Qnil); |
34106
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 if (force_raw_text) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5110 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5111 } |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5112 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5113 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
|
5114 { |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5115 /* Invalid coding system. */ |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5116 |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5117 if (!NILP (noerror)) |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5118 coding_system = Qraw_text; |
89fd59727c6c
(Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents:
34053
diff
changeset
|
5119 else |
71979
dd7e7d68e3b0
(Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents:
71833
diff
changeset
|
5120 xsignal1 (Qcoding_system_error, coding_system); |
34050 | 5121 } |
5122 } | |
5123 | |
5124 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
|
5125 if (prev != current_buffer) |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5126 set_buffer_internal (prev); |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5127 /* 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
|
5128 buffer. */ |
206ba2723812
(Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents:
53393
diff
changeset
|
5129 specpdl_ptr--; |
34050 | 5130 |
5131 if (STRING_MULTIBYTE (object)) | |
89483 | 5132 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); |
34050 | 5133 } |
5134 | |
49246
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5135 md5_buffer (SDATA (object) + start_byte, |
c1dbdec496c3
(Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents:
49204
diff
changeset
|
5136 SBYTES (object) - (size_byte - end_byte), |
34050 | 5137 digest); |
5138 | |
5139 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
|
5140 sprintf (&value[2 * i], "%02x", digest[i]); |
34050 | 5141 value[32] = '\0'; |
5142 | |
5143 return make_string (value, 32); | |
5144 } | |
5145 | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5146 |
21514 | 5147 void |
211 | 5148 syms_of_fns () |
5149 { | |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5150 /* Hash table stuff. */ |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5151 Qhash_table_p = intern ("hash-table-p"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5152 staticpro (&Qhash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5153 Qeq = intern ("eq"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5154 staticpro (&Qeq); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5155 Qeql = intern ("eql"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5156 staticpro (&Qeql); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5157 Qequal = intern ("equal"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5158 staticpro (&Qequal); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5159 QCtest = intern (":test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5160 staticpro (&QCtest); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5161 QCsize = intern (":size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5162 staticpro (&QCsize); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5163 QCrehash_size = intern (":rehash-size"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5164 staticpro (&QCrehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5165 QCrehash_threshold = intern (":rehash-threshold"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5166 staticpro (&QCrehash_threshold); |
25455
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5167 QCweakness = intern (":weakness"); |
8c2f3438bb2c
(QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents:
25365
diff
changeset
|
5168 staticpro (&QCweakness); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5169 Qkey = intern ("key"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5170 staticpro (&Qkey); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5171 Qvalue = intern ("value"); |
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5172 staticpro (&Qvalue); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5173 Qhash_table_test = intern ("hash-table-test"); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5174 staticpro (&Qhash_table_test); |
30496
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5175 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
|
5176 staticpro (&Qkey_or_value); |
25d798a40775
(Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents:
30488
diff
changeset
|
5177 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
|
5178 staticpro (&Qkey_and_value); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5179 |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5180 defsubr (&Ssxhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5181 defsubr (&Smake_hash_table); |
25365
f32071216123
(Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25349
diff
changeset
|
5182 defsubr (&Scopy_hash_table); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5183 defsubr (&Shash_table_count); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5184 defsubr (&Shash_table_rehash_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5185 defsubr (&Shash_table_rehash_threshold); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5186 defsubr (&Shash_table_size); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5187 defsubr (&Shash_table_test); |
25495
5051c1d824fa
(Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents:
25455
diff
changeset
|
5188 defsubr (&Shash_table_weakness); |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5189 defsubr (&Shash_table_p); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5190 defsubr (&Sclrhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5191 defsubr (&Sgethash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5192 defsubr (&Sputhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5193 defsubr (&Sremhash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5194 defsubr (&Smaphash); |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5195 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
|
5196 |
211 | 5197 Qstring_lessp = intern ("string-lessp"); |
5198 staticpro (&Qstring_lessp); | |
2546
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5199 Qprovide = intern ("provide"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5200 staticpro (&Qprovide); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5201 Qrequire = intern ("require"); |
c8cd694d70eb
(provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents:
2525
diff
changeset
|
5202 staticpro (&Qrequire); |
4456
cbfcf187b5da
(Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents:
4004
diff
changeset
|
5203 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
|
5204 staticpro (&Qyes_or_no_p_history); |
14456
fb11ccbe5c7c
(Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14392
diff
changeset
|
5205 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
|
5206 staticpro (&Qcursor_in_echo_area); |
20004 | 5207 Qwidget_type = intern ("widget-type"); |
5208 staticpro (&Qwidget_type); | |
211 | 5209 |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5210 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
|
5211 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
|
5212 |
40474
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5213 require_nesting_list = Qnil; |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5214 staticpro (&require_nesting_list); |
e8c25a61215d
(Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents:
40132
diff
changeset
|
5215 |
14486
3c4ba112108e
(syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents:
14456
diff
changeset
|
5216 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
|
5217 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5218 DEFVAR_LISP ("features", &Vfeatures, |
73686
d2a970fd4273
(Ffeaturep, syms_of_fns): Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
73049
diff
changeset
|
5219 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
|
5220 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
|
5221 Vfeatures = Fcons (intern ("emacs"), Qnil); |
39850
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5222 Qsubfeatures = intern ("subfeatures"); |
80b844540f64
(Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39697
diff
changeset
|
5223 staticpro (&Qsubfeatures); |
211 | 5224 |
49081
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5225 #ifdef HAVE_LANGINFO_CODESET |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5226 Qcodeset = intern ("codeset"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5227 staticpro (&Qcodeset); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5228 Qdays = intern ("days"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5229 staticpro (&Qdays); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5230 Qmonths = intern ("months"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5231 staticpro (&Qmonths); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5232 Qpaper = intern ("paper"); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5233 staticpro (&Qpaper); |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5234 #endif /* HAVE_LANGINFO_CODESET */ |
bd4e0fb1fe78
Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents:
48596
diff
changeset
|
5235 |
39977
51c2b8f7aa5a
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5236 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
|
5237 doc: /* *Non-nil means mouse commands use dialog boxes to ask questions. |
44712 | 5238 This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands |
39899
34ec3a68775d
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39850
diff
changeset
|
5239 invoked by mouse clicks and mouse menu items. */); |
18531
35a263e545b3
(Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents:
18421
diff
changeset
|
5240 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
|
5241 |
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
|
5242 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
|
5243 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
|
5244 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
|
5245 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
|
5246 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
|
5247 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
|
5248 use_file_dialog = 1; |
53255
3b437add35b6
(Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53189
diff
changeset
|
5249 |
211 | 5250 defsubr (&Sidentity); |
5251 defsubr (&Srandom); | |
5252 defsubr (&Slength); | |
12466
b22565172b9b
(Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents:
12062
diff
changeset
|
5253 defsubr (&Ssafe_length); |
20864
ad9e06c97d95
(Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20814
diff
changeset
|
5254 defsubr (&Sstring_bytes); |
211 | 5255 defsubr (&Sstring_equal); |
21671
c359a549f2d2
(Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21580
diff
changeset
|
5256 defsubr (&Scompare_strings); |
211 | 5257 defsubr (&Sstring_lessp); |
5258 defsubr (&Sappend); | |
5259 defsubr (&Sconcat); | |
5260 defsubr (&Svconcat); | |
5261 defsubr (&Scopy_sequence); | |
20667
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5262 defsubr (&Sstring_make_multibyte); |
64af046211eb
(concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents:
20639
diff
changeset
|
5263 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
|
5264 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
|
5265 defsubr (&Sstring_as_unibyte); |
49656
46090ea2c5c3
(string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
49246
diff
changeset
|
5266 defsubr (&Sstring_to_multibyte); |
96248
a2307295cc84
(Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents:
94992
diff
changeset
|
5267 defsubr (&Sstring_to_unibyte); |
211 | 5268 defsubr (&Scopy_alist); |
5269 defsubr (&Ssubstring); | |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5270 defsubr (&Ssubstring_no_properties); |
211 | 5271 defsubr (&Snthcdr); |
5272 defsubr (&Snth); | |
5273 defsubr (&Selt); | |
5274 defsubr (&Smember); | |
5275 defsubr (&Smemq); | |
73029 | 5276 defsubr (&Smemql); |
211 | 5277 defsubr (&Sassq); |
5278 defsubr (&Sassoc); | |
5279 defsubr (&Srassq); | |
10588
2a8f29cd9e9f
(Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10485
diff
changeset
|
5280 defsubr (&Srassoc); |
211 | 5281 defsubr (&Sdelq); |
414 | 5282 defsubr (&Sdelete); |
211 | 5283 defsubr (&Snreverse); |
5284 defsubr (&Sreverse); | |
5285 defsubr (&Ssort); | |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5286 defsubr (&Splist_get); |
211 | 5287 defsubr (&Sget); |
11130
052869c2f609
(Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents:
11094
diff
changeset
|
5288 defsubr (&Splist_put); |
211 | 5289 defsubr (&Sput); |
44159
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5290 defsubr (&Slax_plist_get); |
61c15819e528
(Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44066
diff
changeset
|
5291 defsubr (&Slax_plist_put); |
54987
1b818fd4a373
(Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents:
54373
diff
changeset
|
5292 defsubr (&Seql); |
211 | 5293 defsubr (&Sequal); |
54373
9685a42b7c56
(internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents:
53821
diff
changeset
|
5294 defsubr (&Sequal_including_properties); |
211 | 5295 defsubr (&Sfillarray); |
52075
cda0be6a7138
(Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
51976
diff
changeset
|
5296 defsubr (&Sclear_string); |
211 | 5297 defsubr (&Snconc); |
5298 defsubr (&Smapcar); | |
28666 | 5299 defsubr (&Smapc); |
211 | 5300 defsubr (&Smapconcat); |
5301 defsubr (&Sy_or_n_p); | |
5302 defsubr (&Syes_or_no_p); | |
5303 defsubr (&Sload_average); | |
5304 defsubr (&Sfeaturep); | |
5305 defsubr (&Srequire); | |
5306 defsubr (&Sprovide); | |
29953
dad7b11391a3
(Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29809
diff
changeset
|
5307 defsubr (&Splist_member); |
20004 | 5308 defsubr (&Swidget_put); |
5309 defsubr (&Swidget_get); | |
5310 defsubr (&Swidget_apply); | |
23208
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5311 defsubr (&Sbase64_encode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5312 defsubr (&Sbase64_decode_region); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5313 defsubr (&Sbase64_encode_string); |
1abc842b1ca7
(base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents:
23207
diff
changeset
|
5314 defsubr (&Sbase64_decode_string); |
34050 | 5315 defsubr (&Smd5); |
51976
26f7a240c793
(Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
51768
diff
changeset
|
5316 defsubr (&Slocale_info); |
211 | 5317 } |
25005
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5318 |
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 void |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5321 init_fns () |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5322 { |
95eace73d3ef
(toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents:
24582
diff
changeset
|
5323 } |
52401 | 5324 |
5325 /* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31 | |
5326 (do not change this comment) */ |