annotate src/fns.c @ 54406:1647b704e48e

Provide `register' feature.
author Masatake YAMATO <jet@gyve.org>
date Tue, 16 Mar 2004 09:52:37 +0000
parents 9685a42b7c56
children 1b818fd4a373
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* Random utility Lisp functions.
51768
31f2f6a2df06 (sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51397
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 2003
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
3 Free Software Foundation, Inc.
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5 This file is part of GNU Emacs.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 GNU Emacs is free software; you can redistribute it and/or modify
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 it under the terms of the GNU General Public License as published by
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
9 the Free Software Foundation; either version 2, or (at your option)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10 any later version.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 GNU Emacs is distributed in the hope that it will be useful,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 GNU General Public License for more details.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 along with GNU Emacs; see the file COPYING. If not, write to
14186
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14097
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14097
diff changeset
20 Boston, MA 02111-1307, USA. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4616
diff changeset
22 #include <config.h>
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
24 #ifdef HAVE_UNISTD_H
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
25 #include <unistd.h>
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
26 #endif
21841
12c75f0ef578 Include <time.h> for time.
Andreas Schwab <schwab@suse.de>
parents: 21810
diff changeset
27 #include <time.h>
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
28
50301
c0f3ec529c05 Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents: 49915
diff changeset
29 #ifndef MAC_OSX
c0f3ec529c05 Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents: 49915
diff changeset
30 /* On Mac OS X, defining this conflicts with precompiled headers. */
c0f3ec529c05 Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents: 49915
diff changeset
31
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
32 /* Note on some machines this defines `vector' as a typedef,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33 so make sure we don't use that name in this file. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 #undef vector
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35 #define vector *****
50301
c0f3ec529c05 Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents: 49915
diff changeset
36
c0f3ec529c05 Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents: 49915
diff changeset
37 #endif /* ! MAC_OSX */
c0f3ec529c05 Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents: 49915
diff changeset
38
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
39 #include "lisp.h"
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 #include "commands.h"
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
41 #include "charset.h"
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
42 #include "coding.h"
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 #include "buffer.h"
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
44 #include "keyboard.h"
39697
0b986bb45526 Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39682
diff changeset
45 #include "keymap.h"
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
46 #include "intervals.h"
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
47 #include "frame.h"
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
48 #include "window.h"
37319
b481b8cc3923 Include blockinput.h.
Gerd Moellmann <gerd@gnu.org>
parents: 37317
diff changeset
49 #include "blockinput.h"
21810
15f5abff4d9b [HAVE_MENUS]: Include xterm.h only if HAVE_X_WINDOWS.
Richard M. Stallman <rms@gnu.org>
parents: 21791
diff changeset
50 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS)
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
51 #include "xterm.h"
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
52 #endif
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
53
12062
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
54 #ifndef NULL
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
55 #define NULL ((POINTER_TYPE *)0)
12062
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
56 #endif
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
57
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
58 /* Nonzero enables use of dialog boxes for questions
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
59 asked by mouse commands. */
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
60 int use_dialog_box;
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
61
53189
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
62 /* Nonzero enables use of a file dialog for file name
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
63 questions asked by mouse commands. */
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
64 int use_file_dialog;
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
65
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
66 extern int minibuffer_auto_raise;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
67 extern Lisp_Object minibuf_window;
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
68 extern Lisp_Object Vlocale_coding_system;
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
69
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
70 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
71 Lisp_Object Qyes_or_no_p_history;
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
72 Lisp_Object Qcursor_in_echo_area;
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
73 Lisp_Object Qwidget_type;
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
74 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75
23051
18ed8d6b11e5 (Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents: 22853
diff changeset
76 extern Lisp_Object Qinput_method_function;
18ed8d6b11e5 (Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents: 22853
diff changeset
77
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
78 static int internal_equal ();
21580
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
79
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
80 extern long get_random ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
81 extern void seed_random ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
82
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
83 #ifndef HAVE_UNISTD_H
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
84 extern long time ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
85 #endif
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
86
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
41006
fd83ec62a495 Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 40985
diff changeset
88 doc: /* Return the argument unchanged. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
89 (arg)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 return arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
96 doc: /* Return a pseudo-random number.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
97 All integers representable in Lisp are equally likely.
53255
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
98 On most systems, this is 29 bits' worth.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
99 With positive integer argument N, return random number in interval [0,N).
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
100 With argument t, set the random number seed from the current time and pid. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
101 (n)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
102 Lisp_Object n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 {
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
104 EMACS_INT val;
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
105 Lisp_Object lispy_val;
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
106 unsigned long denominator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
108 if (EQ (n, Qt))
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
109 seed_random (getpid () + time (NULL));
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
110 if (NATNUMP (n) && XFASTINT (n) != 0)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111 {
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
112 /* Try to take our random number from the higher bits of VAL,
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
113 not the lower, since (says Gentzel) the low bits of `random'
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
114 are less random than the higher ones. We do this by using the
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
115 quotient rather than the remainder. At the high end of the RNG
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
116 it's possible to get a quotient larger than n; discarding
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
117 these values eliminates the bias that would otherwise appear
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
118 when using a large n. */
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
119 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
120 do
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
121 val = get_random () / denominator;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
122 while (val >= XFASTINT (n));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 }
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
124 else
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
125 val = get_random ();
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
126 XSETINT (lispy_val, val);
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
127 return lispy_val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130 /* Random data-structure functions */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 DEFUN ("length", Flength, Slength, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
133 doc: /* Return the length of vector, list or string SEQUENCE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
134 A byte-code function object is also allowed.
47762
aa5414c0e056 (Flength): Doc fix.
John Paul Wallington <jpw@pobox.com>
parents: 46425
diff changeset
135 If the string contains multibyte characters, this is not necessarily
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
136 the number of bytes in the string; it is the number of characters.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
137 To get the number of bytes, use `string-bytes'. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
138 (sequence)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
139 register Lisp_Object sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 {
34961
d033c08f2ac6 (Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents: 34722
diff changeset
141 register Lisp_Object val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
143
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
144 retry:
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
145 if (STRINGP (sequence))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
146 XSETFASTINT (val, SCHARS (sequence));
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
147 else if (VECTORP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
148 XSETFASTINT (val, XVECTOR (sequence)->size);
50461
6a4e89f0d078 (Flength): Return SUB_CHAR_TABLE_ORDINARY_SLOTS for sub char tables.
Juanma Barranquero <lekktu@gmail.com>
parents: 50301
diff changeset
149 else if (SUB_CHAR_TABLE_P (sequence))
6a4e89f0d078 (Flength): Return SUB_CHAR_TABLE_ORDINARY_SLOTS for sub char tables.
Juanma Barranquero <lekktu@gmail.com>
parents: 50301
diff changeset
150 XSETFASTINT (val, SUB_CHAR_TABLE_ORDINARY_SLOTS);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
151 else if (CHAR_TABLE_P (sequence))
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
152 XSETFASTINT (val, MAX_CHAR);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
153 else if (BOOL_VECTOR_P (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
154 XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
155 else if (COMPILEDP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
156 XSETFASTINT (val, XVECTOR (sequence)->size & PSEUDOVECTOR_SIZE_MASK);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
157 else if (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 {
26256
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
159 i = 0;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
160 while (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
162 sequence = XCDR (sequence);
26256
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
163 ++i;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
164
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
165 if (!CONSP (sequence))
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
166 break;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
167
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
168 sequence = XCDR (sequence);
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
169 ++i;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
170 QUIT;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
173 if (!NILP (sequence))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
174 wrong_type_argument (Qlistp, sequence);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
175
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
176 val = make_number (i);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
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
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
181 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
182 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 }
9965
f68eab303ddb (Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents: 9927
diff changeset
185 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
188 /* This does not check for quits. That is safe
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
189 since it must terminate. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
190
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
191 DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
192 doc: /* Return the length of a list, but avoid error or infinite loop.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
193 This function never gets an error. If LIST is not really a list,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
194 it returns 0. If LIST is circular, it returns a finite value
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
195 which is at least the number of distinct elements. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
196 (list)
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
197 Lisp_Object list;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
198 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
199 Lisp_Object tail, halftail, length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
200 int len = 0;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
201
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
202 /* halftail is used to detect circular lists. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
203 halftail = list;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
204 for (tail = list; CONSP (tail); tail = XCDR (tail))
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
205 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
206 if (EQ (tail, halftail) && len != 0)
12618
60c4c0fee545 (Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents: 12466
diff changeset
207 break;
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
208 len++;
13344
30e17254a280 (Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents: 13277
diff changeset
209 if ((len & 1) == 0)
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
210 halftail = XCDR (halftail);
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
211 }
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
212
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
213 XSETINT (length, len);
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
214 return length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
215 }
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
216
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
217 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
218 doc: /* Return the number of bytes in STRING.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
219 If STRING is a multibyte string, this is greater than the length of STRING. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
220 (string)
20881
fd35cf0efd94 (Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents: 20880
diff changeset
221 Lisp_Object string;
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
222 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
223 CHECK_STRING (string);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
224 return make_number (SBYTES (string));
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
225 }
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
226
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
228 doc: /* Return t if two strings have identical contents.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
229 Case is significant, but text properties are ignored.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
230 Symbols are also allowed; their print names are used instead. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
231 (s1, s2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
234 if (SYMBOLP (s1))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
235 s1 = SYMBOL_NAME (s1);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
236 if (SYMBOLP (s2))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
237 s2 = SYMBOL_NAME (s2);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
238 CHECK_STRING (s1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
239 CHECK_STRING (s2);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
240
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
241 if (SCHARS (s1) != SCHARS (s2)
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
242 || SBYTES (s1) != SBYTES (s2)
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
243 || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
244 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
245 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
246 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
247
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
248 DEFUN ("compare-strings", Fcompare_strings,
21673
8a32bf93da04 (Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents: 21671
diff changeset
249 Scompare_strings, 6, 7, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
250 doc: /* Compare the contents of two strings, converting to multibyte if needed.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
251 In string STR1, skip the first START1 characters and stop at END1.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
252 In string STR2, skip the first START2 characters and stop at END2.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
253 END1 and END2 default to the full lengths of the respective strings.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
254
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
255 Case is significant in this comparison if IGNORE-CASE is nil.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
256 Unibyte strings are converted to multibyte for comparison.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
257
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
258 The value is t if the strings (or specified portions) match.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
259 If string STR1 is less, the value is a negative number N;
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
260 - 1 - N is the number of characters that match at the beginning.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
261 If string STR1 is greater, the value is a positive number N;
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
262 N - 1 is the number of characters that match at the beginning. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
263 (str1, start1, end1, str2, start2, end2, ignore_case)
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
264 Lisp_Object str1, start1, end1, start2, str2, end2, ignore_case;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
265 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
266 register int end1_char, end2_char;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
267 register int i1, i1_byte, i2, i2_byte;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
268
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
269 CHECK_STRING (str1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
270 CHECK_STRING (str2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
271 if (NILP (start1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
272 start1 = make_number (0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
273 if (NILP (start2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
274 start2 = make_number (0);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
275 CHECK_NATNUM (start1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
276 CHECK_NATNUM (start2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
277 if (! NILP (end1))
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
278 CHECK_NATNUM (end1);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
279 if (! NILP (end2))
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
280 CHECK_NATNUM (end2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
281
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
282 i1 = XINT (start1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
283 i2 = XINT (start2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
284
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
285 i1_byte = string_char_to_byte (str1, i1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
286 i2_byte = string_char_to_byte (str2, i2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
287
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
288 end1_char = SCHARS (str1);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
289 if (! NILP (end1) && end1_char > XINT (end1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
290 end1_char = XINT (end1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
291
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
292 end2_char = SCHARS (str2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
293 if (! NILP (end2) && end2_char > XINT (end2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
294 end2_char = XINT (end2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
295
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
296 while (i1 < end1_char && i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
297 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
298 /* When we find a mismatch, we must compare the
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
299 characters, not just the bytes. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
300 int c1, c2;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
301
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
302 if (STRING_MULTIBYTE (str1))
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
303 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
304 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
305 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
306 c1 = SREF (str1, i1++);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
307 c1 = unibyte_char_to_multibyte (c1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
308 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
309
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
310 if (STRING_MULTIBYTE (str2))
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
311 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
312 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
313 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
314 c2 = SREF (str2, i2++);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
315 c2 = unibyte_char_to_multibyte (c2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
316 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
317
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
318 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
319 continue;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
320
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
321 if (! NILP (ignore_case))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
322 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
323 Lisp_Object tem;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
324
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
325 tem = Fupcase (make_number (c1));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
326 c1 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
327 tem = Fupcase (make_number (c2));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
328 c2 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
329 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
330
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
331 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
332 continue;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
333
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
334 /* Note that I1 has already been incremented
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
335 past the character that we are comparing;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
336 hence we don't add or subtract 1 here. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
337 if (c1 < c2)
37309
aecc289cb0de (Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents: 37279
diff changeset
338 return make_number (- i1 + XINT (start1));
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
339 else
37309
aecc289cb0de (Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents: 37279
diff changeset
340 return make_number (i1 - XINT (start1));
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
341 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
342
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
343 if (i1 < end1_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
344 return make_number (i1 - XINT (start1) + 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
345 if (i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
346 return make_number (- i1 + XINT (start1) - 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
347
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
348 return Qt;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
349 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
350
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
351 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
352 doc: /* Return t if first arg string is less than second in lexicographic order.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
353 Case is significant.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
354 Symbols are also allowed; their print names are used instead. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
355 (s1, s2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
356 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 register int end;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
359 register int i1, i1_byte, i2, i2_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
360
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
361 if (SYMBOLP (s1))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
362 s1 = SYMBOL_NAME (s1);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
363 if (SYMBOLP (s2))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
364 s2 = SYMBOL_NAME (s2);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
365 CHECK_STRING (s1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
366 CHECK_STRING (s2);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
368 i1 = i1_byte = i2 = i2_byte = 0;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
369
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
370 end = SCHARS (s1);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
371 if (end > SCHARS (s2))
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
372 end = SCHARS (s2);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
373
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
374 while (i1 < end)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
375 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
376 /* When we find a mismatch, we must compare the
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
377 characters, not just the bytes. */
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
378 int c1, c2;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
380 FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
381 FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
382
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
383 if (c1 != c2)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
384 return c1 < c2 ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385 }
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
386 return i1 < SCHARS (s2) ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 static Lisp_Object concat ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393 concat2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
394 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
395 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 return concat (2, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402 return concat (2, &s1, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
403 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
404 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
405
8966
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
406 /* ARGSUSED */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
407 Lisp_Object
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
408 concat3 (s1, s2, s3)
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
409 Lisp_Object s1, s2, s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
410 {
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
411 #ifdef NO_ARG_ARRAY
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
412 Lisp_Object args[3];
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
413 args[0] = s1;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
414 args[1] = s2;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
415 args[2] = s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
416 return concat (3, args, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
417 #else
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
418 return concat (3, &s1, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
419 #endif /* NO_ARG_ARRAY */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
420 }
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
421
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
423 doc: /* Concatenate all the arguments and make the result a list.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
424 The result is a list whose elements are the elements of all the arguments.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
425 Each argument may be a list, vector or string.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
426 The last argument is not copied, just used as the tail of the new list.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
427 usage: (append &rest SEQUENCES) */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
428 (nargs, args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432 return concat (nargs, args, Lisp_Cons, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
436 doc: /* Concatenate all the arguments and make the result a string.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
437 The result is a string whose elements are the elements of all the arguments.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
438 Each argument may be a string or a list or vector of characters (integers).
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
439 usage: (concat &rest SEQUENCES) */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
440 (nargs, args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
444 return concat (nargs, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
445 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
446
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
447 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
448 doc: /* Concatenate all the arguments and make the result a vector.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
449 The result is a vector whose elements are the elements of all the arguments.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
450 Each argument may be a list, vector or string.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
451 usage: (vconcat &rest SEQUENCES) */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
452 (nargs, args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
455 {
10006
402c87cbc4fa (Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9965
diff changeset
456 return concat (nargs, args, Lisp_Vectorlike, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458
47762
aa5414c0e056 (Flength): Doc fix.
John Paul Wallington <jpw@pobox.com>
parents: 46425
diff changeset
459 /* Return a copy of a sub char table ARG. The elements except for a
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
460 nested sub char table are not copied. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
461 static Lisp_Object
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
462 copy_sub_char_table (arg)
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
463 Lisp_Object arg;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
464 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
465 Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
466 int i;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
467
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
468 /* Copy all the contents. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
469 bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
470 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
471 /* Recursively copy any sub char-tables in the ordinary slots. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
472 for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
473 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
474 XCHAR_TABLE (copy)->contents[i]
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
475 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
476
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
477 return copy;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
478 }
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
479
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
480
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
48320
de5246a3655a (Fcopy_sequence): Doc fix.
Dave Love <fx@gnu.org>
parents: 48271
diff changeset
482 doc: /* Return a copy of a list, vector, string or char-table.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
483 The elements of a list or vector are not copied; they are shared
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
484 with the original. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
485 (arg)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
488 if (NILP (arg)) return arg;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
489
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
490 if (CHAR_TABLE_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
491 {
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
492 int i;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
493 Lisp_Object copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
494
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
495 copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
496 /* Copy all the slots, including the extra ones. */
17819
6fd66459ec9a (Fcopy_sequence): Correctly copy the char-table contents.
Richard M. Stallman <rms@gnu.org>
parents: 17789
diff changeset
497 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
498 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
499 * sizeof (Lisp_Object)));
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
500
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
501 /* Recursively copy any sub char tables in the ordinary slots
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
502 for multibyte characters. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
503 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
504 i < CHAR_TABLE_ORDINARY_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
505 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
506 XCHAR_TABLE (copy)->contents[i]
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
507 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
508
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
509 return copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
510 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
511
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
512 if (BOOL_VECTOR_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
513 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
514 Lisp_Object val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
515 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
516 = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
517
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
518 val = Fmake_bool_vector (Flength (arg), Qnil);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
519 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
520 size_in_chars);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
521 return val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
522 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
523
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
524 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 arg = wrong_type_argument (Qsequencep, arg);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
529 /* In string STR of length LEN, see if bytes before STR[I] combine
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
530 with bytes after STR[I] to form a single character. If so, return
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
531 the number of bytes after STR[I] which combine in this way.
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
532 Otherwize, return 0. */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
533
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
534 static int
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
535 count_combining (str, len, i)
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
536 unsigned char *str;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
537 int len, i;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
538 {
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
539 int j = i - 1, bytes;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
540
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
541 if (i == 0 || i == len || CHAR_HEAD_P (str[i]))
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
542 return 0;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
543 while (j >= 0 && !CHAR_HEAD_P (str[j])) j--;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
544 if (j < 0 || ! BASE_LEADING_CODE_P (str[j]))
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
545 return 0;
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
546 PARSE_MULTIBYTE_SEQ (str + j, len - j, bytes);
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
547 return (bytes <= i - j ? 0 : bytes - (i - j));
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
548 }
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
549
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
550 /* 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
551 a string and has text properties to be copied. */
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
552 struct textprop_rec
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
553 {
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
554 int argnum; /* refer to ARGS (arguments of `concat') */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
555 int from; /* refer to ARGS[argnum] (argument string) */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
556 int to; /* refer to VAL (the target string) */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
557 };
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
558
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559 static Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560 concat (nargs, args, target_type, last_special)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 enum Lisp_Type target_type;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 int last_special;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 Lisp_Object val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 register Lisp_Object this;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569 int toindex;
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
570 int toindex_byte = 0;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
571 register int result_len;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
572 register int result_len_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 Lisp_Object last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 Lisp_Object prev;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
576 int some_multibyte;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
577 /* 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
578 while concatinating each string because the length of resulting
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
579 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
580 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
581 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
582 struct textprop_rec *textprops = NULL;
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
583 /* Number of elments in textprops. */
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
584 int num_textprops = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
585
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
586 tail = Qnil;
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
587
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
588 /* In append, the last arg isn't treated like the others */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 if (last_special && nargs > 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591 nargs--;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 last_tail = args[nargs];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 last_tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
597 /* Canonicalize each argument. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
598 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
599 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 this = args[argnum];
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
601 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
602 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
604 args[argnum] = wrong_type_argument (Qsequencep, this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
605 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
606 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
607
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
608 /* 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
609 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
610 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
611 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
612 result_len_byte = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
613 result_len = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
614 some_multibyte = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
615 for (argnum = 0; argnum < nargs; argnum++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
616 {
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
617 int len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
618 this = args[argnum];
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
619 len = XFASTINT (Flength (this));
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
620 if (target_type == Lisp_String)
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
621 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
622 /* 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
623 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
624 int i;
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
625 Lisp_Object ch;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
626 int this_len_byte;
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
627
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
628 if (VECTORP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
629 for (i = 0; i < len; i++)
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
630 {
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
631 ch = XVECTOR (this)->contents[i];
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
632 if (! INTEGERP (ch))
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
633 wrong_type_argument (Qintegerp, ch);
23128
45de23c16505 (concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents: 23057
diff changeset
634 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
635 result_len_byte += this_len_byte;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
636 if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
637 some_multibyte = 1;
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
638 }
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
639 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
640 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
641 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
642 for (; CONSP (this); this = XCDR (this))
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
643 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
644 ch = XCAR (this);
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
645 if (! INTEGERP (ch))
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
646 wrong_type_argument (Qintegerp, ch);
23128
45de23c16505 (concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents: 23057
diff changeset
647 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
648 result_len_byte += this_len_byte;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
649 if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
650 some_multibyte = 1;
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
651 }
20639
12240a9b3679 (concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents: 20607
diff changeset
652 else if (STRINGP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
653 {
20699
907d8633c8cc (concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents: 20667
diff changeset
654 if (STRING_MULTIBYTE (this))
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
655 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
656 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
657 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
658 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
659 else
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
660 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
661 SCHARS (this));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
662 }
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
663 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
664
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
665 result_len += len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
666 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
667
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
668 if (! some_multibyte)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
669 result_len_byte = result_len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
670
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
671 /* Create the output object. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
672 if (target_type == Lisp_Cons)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
673 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
674 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
675 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
676 else if (some_multibyte)
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
677 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
678 else
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
679 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
680
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
681 /* 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
682 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
683 return last_tail;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
684
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
685 /* Copy the contents of the args into the result. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
686 if (CONSP (val))
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
687 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
688 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
689 toindex = 0, toindex_byte = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
690
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
691 prev = Qnil;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
692 if (STRINGP (val))
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
693 textprops
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
694 = (struct textprop_rec *) alloca (sizeof (struct textprop_rec) * nargs);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
695
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
696 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
698 Lisp_Object thislen;
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
699 int thisleni = 0;
16863
591b7a95d7a5 (concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents: 16561
diff changeset
700 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
701 register unsigned int thisindex_byte = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
702
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
703 this = args[argnum];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
704 if (!CONSP (this))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
705 thislen = Flength (this), thisleni = XINT (thislen);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
706
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
707 /* 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
708 if (STRINGP (this) && STRINGP (val)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
709 && 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
710 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
711 int thislen_byte = SBYTES (this);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
712 int combined;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
713
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
714 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
715 SBYTES (this));
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
716 combined = (some_multibyte && toindex_byte > 0
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
717 ? count_combining (SDATA (val),
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
718 toindex_byte + thislen_byte,
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
719 toindex_byte)
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
720 : 0);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
721 if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
722 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
723 textprops[num_textprops].argnum = argnum;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
724 /* We ignore text properties on characters being combined. */
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
725 textprops[num_textprops].from = combined;
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
726 textprops[num_textprops++].to = toindex;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
727 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
728 toindex_byte += thislen_byte;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
729 toindex += thisleni - combined;
46374
5d419e7c527d * fns.c (concat): Use STRING_SET_CHARS.
Ken Raeburn <raeburn@raeburn.org>
parents: 46370
diff changeset
730 STRING_SET_CHARS (val, SCHARS (val) - combined);
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
731 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
732 /* 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
733 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
734 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
735 if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
736 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
737 textprops[num_textprops].argnum = argnum;
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
738 textprops[num_textprops].from = 0;
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
739 textprops[num_textprops++].to = toindex;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
740 }
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
741 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
742 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
743 SCHARS (this), 0, 1);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
744 toindex += thisleni;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
745 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
746 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
747 /* Copy element by element. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
748 while (1)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
749 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
750 register Lisp_Object elt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
751
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
752 /* 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
753 `this' is exhausted. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
754 if (NILP (this)) break;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
755 if (CONSP (this))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
756 elt = XCAR (this), this = XCDR (this);
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
757 else if (thisindex >= thisleni)
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
758 break;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
759 else if (STRINGP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
760 {
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
761 int c;
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
762 if (STRING_MULTIBYTE (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
763 {
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
764 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
765 thisindex,
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
766 thisindex_byte);
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
767 XSETFASTINT (elt, c);
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
768 }
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
769 else
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
770 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
771 XSETFASTINT (elt, SREF (this, thisindex++));
23152
7cd25ebef713 (concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents: 23128
diff changeset
772 if (some_multibyte
7cd25ebef713 (concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents: 23128
diff changeset
773 && (XINT (elt) >= 0240
23927
74a3a9c26a03 (concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents: 23901
diff changeset
774 || (XINT (elt) >= 0200
74a3a9c26a03 (concat): Don't convert 7-bit ASCII characters via
Eli Zaretskii <eliz@gnu.org>
parents: 23901
diff changeset
775 && ! NILP (Vnonascii_translation_table)))
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
776 && XINT (elt) < 0400)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
777 {
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
778 c = unibyte_char_to_multibyte (XINT (elt));
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
779 XSETINT (elt, c);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
780 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
781 }
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
782 }
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
783 else if (BOOL_VECTOR_P (this))
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
784 {
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
785 int byte;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
786 byte = XBOOL_VECTOR (this)->data[thisindex / BITS_PER_CHAR];
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
787 if (byte & (1 << (thisindex % BITS_PER_CHAR)))
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
788 elt = Qt;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
789 else
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
790 elt = Qnil;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
791 thisindex++;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
792 }
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
793 else
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
794 elt = XVECTOR (this)->contents[thisindex++];
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
795
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
796 /* 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
797 if (toindex < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
798 {
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39968
diff changeset
799 XSETCAR (tail, elt);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
800 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
801 tail = XCDR (tail);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
802 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
803 else if (VECTORP (val))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
804 XVECTOR (val)->contents[toindex++] = elt;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
805 else
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
806 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
807 CHECK_NUMBER (elt);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
808 if (SINGLE_BYTE_CHAR_P (XINT (elt)))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
809 {
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
810 if (some_multibyte)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
811 toindex_byte
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
812 += CHAR_STRING (XINT (elt),
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
813 SDATA (val) + toindex_byte);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
814 else
46425
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
815 SSET (val, toindex_byte++, XINT (elt));
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
816 if (some_multibyte
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
817 && toindex_byte > 0
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
818 && count_combining (SDATA (val),
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
819 toindex_byte, toindex_byte - 1))
46374
5d419e7c527d * fns.c (concat): Use STRING_SET_CHARS.
Ken Raeburn <raeburn@raeburn.org>
parents: 46370
diff changeset
820 STRING_SET_CHARS (val, SCHARS (val) - 1);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
821 else
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
822 toindex++;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
823 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
824 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
825 /* If we have any multibyte characters,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
826 we already decided to make a multibyte string. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
827 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
828 int c = XINT (elt);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
829 /* P exists as a variable
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
830 to avoid a bug on the Masscomp C compiler. */
46425
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
831 unsigned char *p = SDATA (val) + toindex_byte;
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
832
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
833 toindex_byte += CHAR_STRING (c, p);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
834 toindex++;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
835 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
836 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
837 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
838 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
839 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
840 XSETCDR (prev, last_tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
841
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
842 if (num_textprops > 0)
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
843 {
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
844 Lisp_Object props;
35352
42b56dd8986e (concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents: 35336
diff changeset
845 int last_to_end = -1;
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
846
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
847 for (argnum = 0; argnum < num_textprops; argnum++)
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
848 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
849 this = args[textprops[argnum].argnum];
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
850 props = text_property_list (this,
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
851 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
852 make_number (SCHARS (this)),
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
853 Qnil);
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
854 /* 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
855 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
856 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
857 make_composition_value_copy (props);
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
858 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
859 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
860 last_to_end = textprops[argnum].to + SCHARS (this);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
861 }
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
862 }
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
863 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
864 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
865
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
866 static Lisp_Object string_char_byte_cache_string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
867 static int string_char_byte_cache_charpos;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
868 static int string_char_byte_cache_bytepos;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
869
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
870 void
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
871 clear_string_char_byte_cache ()
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
872 {
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
873 string_char_byte_cache_string = Qnil;
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
874 }
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
875
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
876 /* Return the character index corresponding to CHAR_INDEX in STRING. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
877
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
878 int
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
879 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
880 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
881 int char_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
882 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
883 int i, i_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
884 int best_below, best_below_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
885 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
886
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
887 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
888 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
889 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
890 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
891 return char_index;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
892
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
893 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
894 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
895 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
896 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
897 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
898 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
899 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
900 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
901 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
902 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
903 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
904 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
905 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
906
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
907 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
908 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
909 while (best_below < char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
910 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
911 int c;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
912 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
913 best_below, best_below_byte);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
914 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
915 i = best_below;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
916 i_byte = best_below_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
917 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
918 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
919 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
920 while (best_above > char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
921 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
922 unsigned char *pend = SDATA (string) + best_above_byte;
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
923 unsigned char *pbeg = pend - best_above_byte;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
924 unsigned char *p = pend - 1;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
925 int bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
926
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
927 while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
928 PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
929 if (bytes == pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
930 best_above_byte -= bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
931 else if (bytes > pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
932 best_above_byte -= (pend - p);
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
933 else
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
934 best_above_byte--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
935 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
936 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
937 i = best_above;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
938 i_byte = best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
939 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
940
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
941 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
942 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
943 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
944
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
945 return i_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
946 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
947
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
948 /* 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
949
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
950 int
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
951 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
952 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
953 int byte_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
954 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
955 int i, i_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
956 int best_below, best_below_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
957 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
958
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
959 best_below = best_below_byte = 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
960 best_above = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
961 best_above_byte = SBYTES (string);
53742
2b23252ecc55 (string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents: 53681
diff changeset
962 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
963 return byte_index;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
964
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
965 if (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
966 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
967 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
968 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
969 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
970 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
971 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
972 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
973 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
974 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
975 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
976 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
977 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
978
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
979 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
980 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
981 while (best_below_byte < byte_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
982 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
983 int c;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
984 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
985 best_below, best_below_byte);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
986 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
987 i = best_below;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
988 i_byte = best_below_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
989 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
990 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
991 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
992 while (best_above_byte > byte_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
993 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
994 unsigned char *pend = SDATA (string) + best_above_byte;
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
995 unsigned char *pbeg = pend - best_above_byte;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
996 unsigned char *p = pend - 1;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
997 int bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
998
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
999 while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
1000 PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
1001 if (bytes == pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
1002 best_above_byte -= bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
1003 else if (bytes > pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
1004 best_above_byte -= (pend - p);
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
1005 else
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1006 best_above_byte--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1007 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1008 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1009 i = best_above;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1010 i_byte = best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1011 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1012
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1013 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
1014 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
1015 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
1016
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1017 return i;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1018 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1019
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1020 /* Convert STRING to a multibyte string.
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
1021 Single-byte characters 0240 through 0377 are converted
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1022 by adding nonascii_insert_offset to each. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1023
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1024 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1025 string_make_multibyte (string)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1026 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1027 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1028 unsigned char *buf;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1029 int nbytes;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1030
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1031 if (STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1032 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1033
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1034 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
1035 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
1036 /* 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
1037 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
1038 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
1039 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1040
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1041 buf = (unsigned char *) alloca (nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1042 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
1043 0, 1);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1044
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1045 return make_multibyte_string (buf, SCHARS (string), nbytes);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1046 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1047
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1048
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1049 /* Convert STRING to a multibyte string without changing each
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1050 character codes. Thus, characters 0200 trough 0237 are converted
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1051 to eight-bit-control characters, and characters 0240 through 0377
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1052 are converted eight-bit-graphic characters. */
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1053
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1054 Lisp_Object
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1055 string_to_multibyte (string)
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1056 Lisp_Object string;
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1057 {
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1058 unsigned char *buf;
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1059 int nbytes;
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1060
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1061 if (STRING_MULTIBYTE (string))
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1062 return string;
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1063
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1064 nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
49815
2a19e12053a4 (string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents: 49798
diff changeset
1065 /* If all the chars are ASCII or eight-bit-graphic, they won't need
2a19e12053a4 (string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents: 49798
diff changeset
1066 any more bytes once converted. */
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1067 if (nbytes == SBYTES (string))
49815
2a19e12053a4 (string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents: 49798
diff changeset
1068 return make_multibyte_string (SDATA (string), nbytes, nbytes);
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1069
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1070 buf = (unsigned char *) alloca (nbytes);
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1071 bcopy (SDATA (string), buf, SBYTES (string));
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1072 str_to_multibyte (buf, nbytes, SBYTES (string));
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1073
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1074 return make_multibyte_string (buf, SCHARS (string), nbytes);
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1075 }
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1076
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1077
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1078 /* 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
1079
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1080 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1081 string_make_unibyte (string)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1082 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1083 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1084 unsigned char *buf;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1085
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1086 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1087 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1088
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1089 buf = (unsigned char *) alloca (SCHARS (string));
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1090
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1091 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
1092 1, 0);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1093
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1094 return make_unibyte_string (buf, SCHARS (string));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1095 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1096
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1097 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
1098 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1099 doc: /* Return the multibyte equivalent of STRING.
53255
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
1100 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
1101 `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
1102 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
1103 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
1104 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
1105 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
1106 \(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
1107 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
1108 (string)
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1109 Lisp_Object string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1110 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1111 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1112
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1113 return string_make_multibyte (string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1114 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1115
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1116 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
1117 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1118 doc: /* Return the unibyte equivalent of STRING.
45650
dca52f93fdc0 (Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 45629
diff changeset
1119 Multibyte character codes are converted to unibyte according to
dca52f93fdc0 (Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 45629
diff changeset
1120 `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
1121 If the lookup in the translation table fails, this function takes just
dca52f93fdc0 (Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 45629
diff changeset
1122 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
1123 (string)
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1124 Lisp_Object string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1125 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1126 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1127
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1128 return string_make_unibyte (string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1129 }
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1130
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1131 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
1132 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1133 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
1134 If STRING is unibyte, the result is STRING itself.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1135 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
1136 If STRING is multibyte and contains a character of charset
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1137 `eight-bit-control' or `eight-bit-graphic', it is converted to the
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1138 corresponding single byte. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1139 (string)
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1140 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
1141 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1142 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1143
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1144 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
1145 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1146 int bytes = SBYTES (string);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1147 unsigned char *str = (unsigned char *) xmalloc (bytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1148
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1149 bcopy (SDATA (string), str, bytes);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1150 bytes = str_as_unibyte (str, bytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1151 string = make_unibyte_string (str, bytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1152 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
1153 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1154 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1155 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1156
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1157 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
1158 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1159 doc: /* Return a 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
1160 If STRING is multibyte, the result is STRING itself.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1161 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
1162 If STRING is unibyte and contains an individual 8-bit byte (i.e. not
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1163 part of a multibyte form), it is converted to the corresponding
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1164 multibyte character of charset `eight-bit-control' or `eight-bit-graphic'. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1165 (string)
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1166 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
1167 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1168 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1169
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1170 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
1171 {
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1172 Lisp_Object new_string;
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1173 int nchars, nbytes;
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1174
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1175 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
1176 SBYTES (string),
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1177 &nchars, &nbytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1178 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
1179 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
1180 SBYTES (string));
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1181 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
1182 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
1183 SBYTES (string), NULL);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1184 string = new_string;
46379
18cf1d2514d9 * fns.c (Fstring_as_multibyte): Use STRING_SET_INTERVALS.
Ken Raeburn <raeburn@raeburn.org>
parents: 46374
diff changeset
1185 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
1186 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1187 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1188 }
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1189
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1190 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
1191 1, 1, 0,
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1192 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
1193 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
1194 Otherwise it is a newly created string, with no text properties.
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1195 Characters 0200 through 0237 are converted to eight-bit-control
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1196 characters of the same character code. Characters 0240 through 0377
53042
ad6fbb925d66 (Fstring_to_multibyte): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 52766
diff changeset
1197 are converted to eight-bit-graphic characters of the same character
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1198 codes. */)
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1199 (string)
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1200 Lisp_Object string;
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1201 {
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1202 CHECK_STRING (string);
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1203
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1204 return string_to_multibyte (string);
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1205 }
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1206
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1207
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1208 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1209 doc: /* Return a copy of ALIST.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1210 This is an alist which represents the same mapping from objects to objects,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1211 but does not share the alist structure with ALIST.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1212 The objects mapped (cars and cdrs of elements of the alist)
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1213 are shared, however.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1214 Elements of ALIST that are not conses are also shared. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1215 (alist)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1216 Lisp_Object alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1217 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1218 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1219
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1220 CHECK_LIST (alist);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1221 if (NILP (alist))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1222 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1223 alist = concat (1, &alist, Lisp_Cons, 0);
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1224 for (tem = alist; CONSP (tem); tem = XCDR (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1225 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1226 register Lisp_Object car;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1227 car = XCAR (tem);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1228
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1229 if (CONSP (car))
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39968
diff changeset
1230 XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1231 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1232 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1233 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1234
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1235 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
41006
fd83ec62a495 Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 40985
diff changeset
1236 doc: /* Return a substring of STRING, starting at index FROM and ending before TO.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1237 TO may be nil or omitted; then the substring runs to the end of STRING.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
1238 FROM and TO start at 0. If either is negative, it counts from the end.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1239
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1240 This function allows vectors as well as strings. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1241 (string, from, to)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1242 Lisp_Object string;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1243 register Lisp_Object from, to;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1244 {
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1245 Lisp_Object res;
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1246 int size;
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
1247 int size_byte = 0;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1248 int from_char, to_char;
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
1249 int from_byte = 0, to_byte = 0;
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1250
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1251 if (! (STRINGP (string) || VECTORP (string)))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1252 wrong_type_argument (Qarrayp, string);
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1253
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1254 CHECK_NUMBER (from);
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1255
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1256 if (STRINGP (string))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1257 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1258 size = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1259 size_byte = SBYTES (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1260 }
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1261 else
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1262 size = XVECTOR (string)->size;
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1263
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1264 if (NILP (to))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1265 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1266 to_char = size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1267 to_byte = size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1268 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1269 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1270 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1271 CHECK_NUMBER (to);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1272
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1273 to_char = XINT (to);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1274 if (to_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1275 to_char += size;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1276
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1277 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1278 to_byte = string_char_to_byte (string, to_char);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1279 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1280
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1281 from_char = XINT (from);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1282 if (from_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1283 from_char += size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1284 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1285 from_byte = string_char_to_byte (string, from_char);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1286
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1287 if (!(0 <= from_char && from_char <= to_char && to_char <= size))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1288 args_out_of_range_3 (string, make_number (from_char),
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1289 make_number (to_char));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1290
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1291 if (STRINGP (string))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1292 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1293 res = make_specified_string (SDATA (string) + from_byte,
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1294 to_char - from_char, to_byte - from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1295 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1296 copy_text_properties (make_number (from_char), make_number (to_char),
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1297 string, make_number (0), res, Qnil);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1298 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1299 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1300 res = Fvector (to_char - from_char,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1301 XVECTOR (string)->contents + from_char);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1302
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1303 return res;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1304 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1305
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1306
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1307 DEFUN ("substring-no-properties", Fsubstring_no_properties, Ssubstring_no_properties, 1, 3, 0,
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1308 doc: /* Return a substring of STRING, without text properties.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1309 It starts at index FROM and ending before TO.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1310 TO may be nil or omitted; then the substring runs to the end of STRING.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1311 If FROM is nil or omitted, the substring starts at the beginning of STRING.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1312 If FROM or TO is negative, it counts from the end.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1313
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1314 With one argument, just copy STRING without its properties. */)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1315 (string, from, to)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1316 Lisp_Object string;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1317 register Lisp_Object from, to;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1318 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1319 int size, size_byte;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1320 int from_char, to_char;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1321 int from_byte, to_byte;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1322
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1323 CHECK_STRING (string);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1324
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1325 size = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1326 size_byte = SBYTES (string);
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1327
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1328 if (NILP (from))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1329 from_char = from_byte = 0;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1330 else
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1331 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1332 CHECK_NUMBER (from);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1333 from_char = XINT (from);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1334 if (from_char < 0)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1335 from_char += size;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1336
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1337 from_byte = string_char_to_byte (string, from_char);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1338 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1339
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1340 if (NILP (to))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1341 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1342 to_char = size;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1343 to_byte = size_byte;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1344 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1345 else
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1346 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1347 CHECK_NUMBER (to);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1348
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1349 to_char = XINT (to);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1350 if (to_char < 0)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1351 to_char += size;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1352
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1353 to_byte = string_char_to_byte (string, to_char);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1354 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1355
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1356 if (!(0 <= from_char && from_char <= to_char && to_char <= size))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1357 args_out_of_range_3 (string, make_number (from_char),
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1358 make_number (to_char));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1359
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1360 return make_specified_string (SDATA (string) + from_byte,
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1361 to_char - from_char, to_byte - from_byte,
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1362 STRING_MULTIBYTE (string));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1363 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1364
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1365 /* Extract a substring of STRING, giving start and end positions
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1366 both in characters and in bytes. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1367
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1368 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1369 substring_both (string, from, from_byte, to, to_byte)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1370 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1371 int from, from_byte, to, to_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1372 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1373 Lisp_Object res;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1374 int size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1375 int size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1376
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1377 if (! (STRINGP (string) || VECTORP (string)))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1378 wrong_type_argument (Qarrayp, string);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1379
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1380 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1381 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1382 size = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1383 size_byte = SBYTES (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1384 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1385 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1386 size = XVECTOR (string)->size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1387
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1388 if (!(0 <= from && from <= to && to <= size))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1389 args_out_of_range_3 (string, make_number (from), make_number (to));
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1390
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1391 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1392 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1393 res = make_specified_string (SDATA (string) + from_byte,
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1394 to - from, to_byte - from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1395 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1396 copy_text_properties (make_number (from), make_number (to),
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1397 string, make_number (0), res, Qnil);
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1398 }
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1399 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1400 res = Fvector (to - from,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1401 XVECTOR (string)->contents + from);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1402
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1403 return res;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1404 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1405
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1406 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1407 doc: /* Take cdr N times on LIST, returns the result. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1408 (n, list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1409 Lisp_Object n;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1410 register Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1411 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1412 register int i, num;
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1413 CHECK_NUMBER (n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1414 num = XINT (n);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1415 for (i = 0; i < num && !NILP (list); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1416 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1417 QUIT;
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1418 if (! CONSP (list))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1419 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1420 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1423 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1424
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1425 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1426 doc: /* Return the Nth element of LIST.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1427 N counts from zero. If LIST is not that long, nil is returned. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1428 (n, list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1429 Lisp_Object n, list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1431 return Fcar (Fnthcdr (n, list));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1432 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1433
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1434 DEFUN ("elt", Felt, Selt, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1435 doc: /* Return element of SEQUENCE at index N. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1436 (sequence, n)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1437 register Lisp_Object sequence, n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1438 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1439 CHECK_NUMBER (n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1440 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1441 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1442 if (CONSP (sequence) || NILP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1443 return Fcar (Fnthcdr (n, sequence));
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1444 else if (STRINGP (sequence) || VECTORP (sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1445 || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1446 return Faref (sequence, n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1447 else
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1448 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1449 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1450 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1451
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1452 DEFUN ("member", Fmember, Smember, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1453 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1454 The value is actually the tail of LIST whose car is ELT. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1455 (elt, list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1456 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1457 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1458 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1459 register Lisp_Object tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1460 for (tail = list; !NILP (tail); tail = XCDR (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1461 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1462 register Lisp_Object tem;
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1463 if (! CONSP (tail))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1464 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1465 tem = XCAR (tail);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1466 if (! NILP (Fequal (elt, tem)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467 return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1468 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1469 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1470 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1471 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1472
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1473 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1474 doc: /* Return non-nil if ELT is an element of LIST.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1475 Comparison done with EQ. The value is actually the tail of LIST
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1476 whose car is ELT. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1477 (elt, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1478 Lisp_Object elt, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1479 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1480 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1481 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1482 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1483 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1484
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1485 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1486 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1487 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1488
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1489 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1490 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1491 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1492
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1493 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1494 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1495 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1496
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1497 if (!CONSP (list) && !NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1498 list = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1499
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1500 return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1501 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1502
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1503 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1504 doc: /* Return non-nil if KEY is `eq' to the car of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1505 The value is actually the first element of LIST whose car is KEY.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1506 Elements of LIST that are not conses are ignored. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1507 (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1508 Lisp_Object key, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1509 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1510 Lisp_Object result;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1511
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1512 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1513 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1514 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1515 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1516 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1517 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1518
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1519 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1520 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1521 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1522 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1523 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1524
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1525 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1526 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1527 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1528 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1529 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1530
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1531 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1532 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1533 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1534
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1535 if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1536 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1537 else if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1538 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1539 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1540 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1541
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1542 return result;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1543 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1544
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1545 /* Like Fassq but never report an error and do not allow quits.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1546 Use only on lists known never to be circular. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1547
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1548 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549 assq_no_quit (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1550 Lisp_Object key, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1551 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1552 while (CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1553 && (!CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1554 || !EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1555 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1556
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1557 return CONSP (list) ? XCAR (list) : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1558 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1559
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1560 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1561 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1562 The value is actually the first element of LIST whose car equals KEY. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1563 (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1564 Lisp_Object key, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1565 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1566 Lisp_Object result, car;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1567
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1568 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1569 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1570 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1571 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1572 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1573 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1574 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1575
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1576 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1577 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1578 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1579 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1580 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1581 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1582
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1583 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1584 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1585 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1586 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1587 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1588 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1589
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1590 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1591 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1592 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1593
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1594 if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1595 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1596 else if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1597 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1598 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1599 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1600
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1601 return result;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1602 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1603
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1604 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1605 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1606 The value is actually the first element of LIST whose cdr is KEY. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1607 (key, list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1608 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1609 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1610 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1611 Lisp_Object result;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1612
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1613 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1614 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1615 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1616 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1617 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1618 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1619
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1620 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1621 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1622 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1623 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1624 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1625
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1626 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1627 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1628 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1629 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1630 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1631
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1632 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1633 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1635
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1636 if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1637 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1638 else if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1639 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1640 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1641 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1642
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1643 return result;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1644 }
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1645
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1646 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1647 doc: /* Return non-nil if KEY is `equal' to the cdr of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1648 The value is actually the first element of LIST whose cdr equals KEY. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1649 (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1650 Lisp_Object key, list;
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1651 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1652 Lisp_Object result, cdr;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1653
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1654 while (1)
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1655 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1656 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1657 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1658 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1659 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1660 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1661
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1662 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1663 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1664 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1665 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1666 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1667 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1668
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1669 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1670 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1671 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1672 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1673 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1674 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1675
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1676 list = XCDR (list);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1677 QUIT;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1678 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1679
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1680 if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1681 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1682 else if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1683 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1684 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1685 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1686
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1687 return result;
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1688 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1689
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1691 doc: /* Delete by side effect any occurrences of ELT as a member of LIST.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1692 The modified LIST is returned. Comparison is done with `eq'.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1693 If the first member of LIST is ELT, there is no way to remove it by side effect;
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1694 therefore, write `(setq foo (delq element foo))'
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1695 to be sure of changing the value of `foo'. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1696 (elt, list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1697 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1698 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1699 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1700 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1701 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1702
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1703 tail = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1704 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1705 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1706 {
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1707 if (! CONSP (tail))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1708 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1709 tem = XCAR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1710 if (EQ (elt, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1711 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1712 if (NILP (prev))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1713 list = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1714 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1715 Fsetcdr (prev, XCDR (tail));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1716 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1717 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1718 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1719 tail = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1720 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1721 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1722 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1723 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1724
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
1725 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1726 doc: /* Delete by side effect any occurrences of ELT as a member of SEQ.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1727 SEQ must be a list, a vector, or a string.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1728 The modified SEQ is returned. Comparison is done with `equal'.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1729 If SEQ is not a list, or the first member of SEQ is ELT, deleting it
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1730 is not a side effect; it is simply using a different sequence.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1731 Therefore, write `(setq foo (delete element foo))'
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1732 to be sure of changing the value of `foo'. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1733 (elt, seq)
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1734 Lisp_Object elt, seq;
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1735 {
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1736 if (VECTORP (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1737 {
34961
d033c08f2ac6 (Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents: 34722
diff changeset
1738 EMACS_INT i, n;
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1739
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1740 for (i = n = 0; i < ASIZE (seq); ++i)
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1741 if (NILP (Fequal (AREF (seq, i), elt)))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1742 ++n;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1743
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1744 if (n != ASIZE (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1745 {
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
1746 struct Lisp_Vector *p = allocate_vector (n);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1747
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1748 for (i = n = 0; i < ASIZE (seq); ++i)
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1749 if (NILP (Fequal (AREF (seq, i), elt)))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1750 p->contents[n++] = AREF (seq, i);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1751
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1752 XSETVECTOR (seq, p);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1753 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1754 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1755 else if (STRINGP (seq))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1756 {
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1757 EMACS_INT i, ibyte, nchars, nbytes, cbytes;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1758 int c;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1759
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1760 for (i = nchars = nbytes = ibyte = 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1761 i < SCHARS (seq);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1762 ++i, ibyte += cbytes)
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1763 {
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1764 if (STRING_MULTIBYTE (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1765 {
46425
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
1766 c = STRING_CHAR (SDATA (seq) + ibyte,
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1767 SBYTES (seq) - ibyte);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1768 cbytes = CHAR_BYTES (c);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1769 }
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1770 else
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1771 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1772 c = SREF (seq, i);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1773 cbytes = 1;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1774 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1775
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1776 if (!INTEGERP (elt) || c != XINT (elt))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1777 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1778 ++nchars;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1779 nbytes += cbytes;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1780 }
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1781 }
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1782
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1783 if (nchars != SCHARS (seq))
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1784 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1785 Lisp_Object tem;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1786
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1787 tem = make_uninit_multibyte_string (nchars, nbytes);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1788 if (!STRING_MULTIBYTE (seq))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1789 STRING_SET_UNIBYTE (tem);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1790
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1791 for (i = nchars = nbytes = ibyte = 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1792 i < SCHARS (seq);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1793 ++i, ibyte += cbytes)
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1794 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1795 if (STRING_MULTIBYTE (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1796 {
46425
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
1797 c = STRING_CHAR (SDATA (seq) + ibyte,
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1798 SBYTES (seq) - ibyte);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1799 cbytes = CHAR_BYTES (c);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1800 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1801 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1802 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1803 c = SREF (seq, i);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1804 cbytes = 1;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1805 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1806
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1807 if (!INTEGERP (elt) || c != XINT (elt))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1808 {
46425
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
1809 unsigned char *from = SDATA (seq) + ibyte;
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
1810 unsigned char *to = SDATA (tem) + nbytes;
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1811 EMACS_INT n;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1812
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1813 ++nchars;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1814 nbytes += cbytes;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1815
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1816 for (n = cbytes; n--; )
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1817 *to++ = *from++;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1818 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1819 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1820
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1821 seq = tem;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1822 }
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1823 }
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1824 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1825 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1826 Lisp_Object tail, prev;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1827
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1828 for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1829 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1830 if (!CONSP (tail))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1831 wrong_type_argument (Qlistp, seq);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1832
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1833 if (!NILP (Fequal (elt, XCAR (tail))))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1834 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1835 if (NILP (prev))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1836 seq = XCDR (tail);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1837 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1838 Fsetcdr (prev, XCDR (tail));
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1839 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1840 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1841 prev = tail;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1842 QUIT;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1843 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1844 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1845
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1846 return seq;
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1847 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1848
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1849 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1850 doc: /* Reverse LIST by modifying cdr pointers.
53106
b4b8c928aba2 (Freverse): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53090
diff changeset
1851 Return the reversed list. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1852 (list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1853 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1854 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1855 register Lisp_Object prev, tail, next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1856
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1857 if (NILP (list)) return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1858 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1859 tail = list;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1860 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1861 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1862 QUIT;
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1863 if (! CONSP (tail))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1864 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1865 next = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1866 Fsetcdr (tail, prev);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1867 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1868 tail = next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1869 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1870 return prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1871 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1872
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1873 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
53106
b4b8c928aba2 (Freverse): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53090
diff changeset
1874 doc: /* Reverse LIST, copying. Return the reversed list.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1875 See also the function `nreverse', which is used more often. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1876 (list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1877 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1878 {
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1879 Lisp_Object new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1880
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1881 for (new = Qnil; CONSP (list); list = XCDR (list))
49204
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1882 {
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1883 QUIT;
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1884 new = Fcons (XCAR (list), new);
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1885 }
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1886 if (!NILP (list))
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1887 wrong_type_argument (Qconsp, list);
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1888 return new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1889 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1890
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1891 Lisp_Object merge ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1892
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1893 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1894 doc: /* Sort LIST, stably, comparing elements using PREDICATE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1895 Returns the sorted list. LIST is modified by side effects.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1896 PREDICATE is called with two elements of LIST, and should return t
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1897 if the first element is "less" than the second. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1898 (list, predicate)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1899 Lisp_Object list, predicate;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1900 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1901 Lisp_Object front, back;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1902 register Lisp_Object len, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1903 struct gcpro gcpro1, gcpro2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1904 register int length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1905
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1906 front = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1907 len = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1908 length = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1909 if (length < 2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1910 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1911
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1912 XSETINT (len, (length / 2) - 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1913 tem = Fnthcdr (len, list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1914 back = Fcdr (tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1915 Fsetcdr (tem, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1916
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1917 GCPRO2 (front, back);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1918 front = Fsort (front, predicate);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1919 back = Fsort (back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1920 UNGCPRO;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1921 return merge (front, back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1922 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1923
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1924 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1925 merge (org_l1, org_l2, pred)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1926 Lisp_Object org_l1, org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1927 Lisp_Object pred;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1928 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1929 Lisp_Object value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1930 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1931 Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1932 register Lisp_Object l1, l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1933 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1934
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1935 l1 = org_l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1936 l2 = org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1937 tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1938 value = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1939
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1940 /* It is sufficient to protect org_l1 and org_l2.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 When l1 and l2 are updated, we copy the new values
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1942 back into the org_ vars. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1943 GCPRO4 (org_l1, org_l2, pred, value);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1944
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1945 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1946 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1947 if (NILP (l1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1948 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1949 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1950 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1951 return l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 Fsetcdr (tail, l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1954 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1955 if (NILP (l2))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1956 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1957 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1958 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1959 return l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1960 Fsetcdr (tail, l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1961 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1962 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1963 tem = call2 (pred, Fcar (l2), Fcar (l1));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1964 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1965 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1966 tem = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1967 l1 = Fcdr (l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1968 org_l1 = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1969 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1970 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1971 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1972 tem = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1973 l2 = Fcdr (l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1974 org_l2 = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1976 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1977 value = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1978 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1979 Fsetcdr (tail, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1980 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1981 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1982 }
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1983
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1984
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1985 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
1986 doc: /* Extract a value from a property list.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1987 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
1988 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1989 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
1990 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
1991 (plist, prop)
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
1992 Lisp_Object plist;
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1993 Lisp_Object prop;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1994 {
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1995 Lisp_Object tail;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
1996
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1997 for (tail = plist;
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1998 CONSP (tail) && CONSP (XCDR (tail));
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1999 tail = XCDR (XCDR (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2000 {
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
2001 if (EQ (prop, XCAR (tail)))
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
2002 return XCAR (XCDR (tail));
37317
36d04528f2aa (Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents: 37309
diff changeset
2003
36d04528f2aa (Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents: 37309
diff changeset
2004 /* 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
2005 (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
2006 if (!interrupt_input_blocked)
36d04528f2aa (Fplist_get): Don't QUIT is interrupt_input_blocked.
Gerd Moellmann <gerd@gnu.org>
parents: 37309
diff changeset
2007 QUIT;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2008 }
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
2009
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
2010 if (!NILP (tail))
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
2011 wrong_type_argument (Qlistp, prop);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2012
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2014 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2015
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2016 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
2017 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
2018 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
2019 (symbol, propname)
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
2020 Lisp_Object symbol, propname;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2021 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2022 CHECK_SYMBOL (symbol);
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
2023 return Fplist_get (XSYMBOL (symbol)->plist, propname);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2024 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2025
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2026 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
2027 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
2028 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
2029 \(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
2030 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
2031 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
2032 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
2033 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
2034 (plist, prop, val)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2035 Lisp_Object plist;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2036 register Lisp_Object prop;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2037 Lisp_Object val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2038 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2039 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2040 Lisp_Object newcell;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2041 prev = Qnil;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2042 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
2043 tail = XCDR (XCDR (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2044 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2045 if (EQ (prop, XCAR (tail)))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2046 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2047 Fsetcar (XCDR (tail), val);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2048 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2049 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2050
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2051 prev = tail;
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
2052 QUIT;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2053 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2054 newcell = Fcons (prop, Fcons (val, Qnil));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2055 if (NILP (prev))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2056 return newcell;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2057 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2058 Fsetcdr (XCDR (prev), newcell);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2059 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2060 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2061
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2062 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
2063 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
2064 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
2065 (symbol, propname, value)
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
2066 Lisp_Object symbol, propname, value;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2067 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2068 CHECK_SYMBOL (symbol);
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
2069 XSYMBOL (symbol)->plist
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
2070 = 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
2071 return value;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2072 }
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2073
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2074 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
2075 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
2076 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
2077 \(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
2078 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
2079 one of the properties on the list. */)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2080 (plist, prop)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2081 Lisp_Object plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2082 Lisp_Object prop;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2083 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2084 Lisp_Object tail;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2085
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2086 for (tail = plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2087 CONSP (tail) && CONSP (XCDR (tail));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2088 tail = XCDR (XCDR (tail)))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2089 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2090 if (! NILP (Fequal (prop, XCAR (tail))))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2091 return XCAR (XCDR (tail));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2092
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2093 QUIT;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2094 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2095
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2096 if (!NILP (tail))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2097 wrong_type_argument (Qlistp, prop);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2098
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2099 return Qnil;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2100 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2101
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2102 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
2103 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
2104 PLIST is a property list, which is a list of the form
44219
dfaa607f640f (Flax_plist_put): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 44159
diff changeset
2105 \(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
2106 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
2107 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
2108 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
2109 The PLIST is modified by side effects. */)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2110 (plist, prop, val)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2111 Lisp_Object plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2112 register Lisp_Object prop;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2113 Lisp_Object val;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2114 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2115 register Lisp_Object tail, prev;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2116 Lisp_Object newcell;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2117 prev = Qnil;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2118 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2119 tail = XCDR (XCDR (tail)))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2120 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2121 if (! NILP (Fequal (prop, XCAR (tail))))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2122 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2123 Fsetcar (XCDR (tail), val);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2124 return plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2125 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2126
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2127 prev = tail;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2128 QUIT;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2129 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2130 newcell = Fcons (prop, Fcons (val, Qnil));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2131 if (NILP (prev))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2132 return newcell;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2133 else
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2134 Fsetcdr (XCDR (prev), newcell);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2135 return plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2136 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
2137
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2138 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
2139 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
2140 They must have the same data type.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2141 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
2142 Vectors and strings are compared element by element.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2143 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
2144 (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
2145 Symbols must match exactly. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2146 (o1, o2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2147 register Lisp_Object o1, o2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2148 {
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2149 return internal_equal (o1, o2, 0, 0) ? Qt : Qnil;
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2150 }
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2151
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2152 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
2153 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
2154 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
2155 of strings. (`equal' ignores text properties.) */)
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2156 (o1, o2)
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2157 register Lisp_Object o1, o2;
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2158 {
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2159 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
2160 }
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2161
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2162 /* 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
2163 gets too deep.
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2164 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
2165
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2166 static int
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2167 internal_equal (o1, o2, depth, props)
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2168 register Lisp_Object o1, o2;
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2169 int depth, props;
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2170 {
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2171 if (depth > 200)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2172 error ("Stack overflow in equal");
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2173
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2174 tail_recurse:
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2175 QUIT;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2176 if (EQ (o1, o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2177 return 1;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2178 if (XTYPE (o1) != XTYPE (o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2179 return 0;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2180
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2181 switch (XTYPE (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2182 {
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2183 case Lisp_Float:
53393
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2184 {
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2185 double d1, d2;
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2186
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2187 d1 = extract_float (o1);
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2188 d2 = extract_float (o2);
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2189 /* 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
2190 though they are not =. */
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2191 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
2192 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2193
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2194 case Lisp_Cons:
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2195 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
2196 return 0;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2197 o1 = XCDR (o1);
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2198 o2 = XCDR (o2);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2199 goto tail_recurse;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2200
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2201 case Lisp_Misc:
11240
2642924d2d21 (internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2202 if (XMISCTYPE (o1) != XMISCTYPE (o2))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2203 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2204 if (OVERLAYP (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2205 {
25149
ee483f870bde (internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents: 25094
diff changeset
2206 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
2207 depth + 1, props)
25149
ee483f870bde (internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents: 25094
diff changeset
2208 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2209 depth + 1))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2210 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2211 o1 = XOVERLAY (o1)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2212 o2 = XOVERLAY (o2)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2213 goto tail_recurse;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2214 }
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2215 if (MARKERP (o1))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2216 {
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2217 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
2218 && (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
2219 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2220 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2221 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2222
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2223 case Lisp_Vectorlike:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2224 {
53159
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2225 register int i;
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2226 EMACS_INT size = XVECTOR (o1)->size;
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2227 /* 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
2228 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
2229 same size. */
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2230 if (XVECTOR (o2)->size != size)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2231 return 0;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2232 /* Boolvectors are compared much like strings. */
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2233 if (BOOL_VECTOR_P (o1))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2234 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2235 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
2236 = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2237
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2238 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
2239 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2240 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
2241 size_in_chars))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2242 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2243 return 1;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2244 }
20776
219fdecc30d3 (internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents: 20712
diff changeset
2245 if (WINDOW_CONFIGURATIONP (o1))
21021
7be2384fabdc (internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents: 20992
diff changeset
2246 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
2247
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2248 /* Aside from them, only true vectors, char-tables, and compiled
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2249 functions are sensible to compare, so eliminate the others now. */
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2250 if (size & PSEUDOVECTOR_FLAG)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2251 {
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2252 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))
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 size &= PSEUDOVECTOR_SIZE_MASK;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2255 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2256 for (i = 0; i < size; i++)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2257 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2258 Lisp_Object v1, v2;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2259 v1 = XVECTOR (o1)->contents [i];
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2260 v2 = XVECTOR (o2)->contents [i];
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2261 if (!internal_equal (v1, v2, depth + 1, props))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2262 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2263 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2264 return 1;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2265 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2266 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2267
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2268 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
2269 if (SCHARS (o1) != SCHARS (o2))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2270 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
2271 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
2272 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
2273 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
2274 SBYTES (o1)))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2275 return 0;
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2276 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
2277 return 0;
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2278 return 1;
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2279
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2280 case Lisp_Int:
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2281 case Lisp_Symbol:
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2282 case Lisp_Type_Limit:
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2283 break;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2284 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2285
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2286 return 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2287 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2288
18613
614b916ff5bf Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents: 18531
diff changeset
2289 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
2290
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2291 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
2292 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
2293 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
2294 (array, item)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2295 Lisp_Object array, item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2296 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2297 register int size, index, charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2298 retry:
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2299 if (VECTORP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2300 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2301 register Lisp_Object *p = XVECTOR (array)->contents;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2302 size = XVECTOR (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2303 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2304 p[index] = item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2305 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2306 else if (CHAR_TABLE_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2307 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2308 register Lisp_Object *p = XCHAR_TABLE (array)->contents;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2309 size = CHAR_TABLE_ORDINARY_SLOTS;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2310 for (index = 0; index < size; index++)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2311 p[index] = item;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2312 XCHAR_TABLE (array)->defalt = Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2313 }
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2314 else if (STRINGP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2315 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2316 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
2317 CHECK_NUMBER (item);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2318 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
2319 size = SCHARS (array);
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2320 if (STRING_MULTIBYTE (array))
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2321 {
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
2322 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
2323 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
2324 int size_byte = SBYTES (array);
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2325 unsigned char *p1 = p, *endp = p + size_byte;
23453
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2326 int i;
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2327
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2328 if (size != size_byte)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2329 while (p1 < endp)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2330 {
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2331 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1);
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2332 if (len != this_len)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2333 error ("Attempt to change byte length of a string");
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2334 p1 += this_len;
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2335 }
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2336 for (i = 0; i < size_byte; i++)
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2337 *p++ = str[i % len];
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2338 }
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2339 else
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2340 for (index = 0; index < size; index++)
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2341 p[index] = charval;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2342 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2343 else if (BOOL_VECTOR_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2344 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2345 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
2346 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
2347 = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2348
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2349 charval = (! NILP (item) ? -1 : 0);
53159
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2350 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
2351 p[index] = charval;
53159
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2352 if (index < size_in_chars)
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2353 {
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2354 /* Mask out bits beyond the vector size. */
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2355 if (XBOOL_VECTOR (array)->size % BITS_PER_CHAR)
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2356 charval &= (1 << (XBOOL_VECTOR (array)->size % BITS_PER_CHAR)) - 1;
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2357 p[index] = charval;
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2358 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2359 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2360 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2361 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2362 array = wrong_type_argument (Qarrayp, array);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2363 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2364 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2365 return array;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2366 }
52075
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2367
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2368 DEFUN ("clear-string", Fclear_string, Sclear_string,
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2369 1, 1, 0,
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2370 doc: /* Clear the contents of STRING.
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2371 This makes STRING unibyte and may change its length. */)
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2372 (string)
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2373 Lisp_Object string;
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2374 {
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2375 int len = SBYTES (string);
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2376 bzero (SDATA (string), len);
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2377 STRING_SET_CHARS (string, len);
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2378 STRING_SET_UNIBYTE (string);
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2379 return Qnil;
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2380 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2381
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2382 DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2383 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2384 doc: /* Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2385 (char_table)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2386 Lisp_Object char_table;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2387 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2388 CHECK_CHAR_TABLE (char_table);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2389
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2390 return XCHAR_TABLE (char_table)->purpose;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2391 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2392
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2393 DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2394 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2395 doc: /* Return the parent char-table of CHAR-TABLE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2396 The value is either nil or another char-table.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2397 If CHAR-TABLE holds nil for a given character,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2398 then the actual applicable value is inherited from the parent char-table
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2399 \(or from its parents, if necessary). */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2400 (char_table)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2401 Lisp_Object char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2402 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2403 CHECK_CHAR_TABLE (char_table);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2404
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2405 return XCHAR_TABLE (char_table)->parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2406 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2407
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2408 DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2409 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2410 doc: /* Set the parent char-table of CHAR-TABLE to PARENT.
53138
7cf5bcb7a8ad (Fset_char_table_parent): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53115
diff changeset
2411 Return PARENT. PARENT must be either nil or another char-table. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2412 (char_table, parent)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2413 Lisp_Object char_table, parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2414 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2415 Lisp_Object temp;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2416
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2417 CHECK_CHAR_TABLE (char_table);
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2418
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2419 if (!NILP (parent))
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2420 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2421 CHECK_CHAR_TABLE (parent);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2422
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2423 for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
14097
91c55574973f (Fset_char_table_parent): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 14091
diff changeset
2424 if (EQ (temp, char_table))
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2425 error ("Attempt to make a chartable be its own parent");
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2426 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2427
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2428 XCHAR_TABLE (char_table)->parent = parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2429
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2430 return parent;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2431 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2432
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2433 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2434 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2435 doc: /* Return the value of CHAR-TABLE's extra-slot number N. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2436 (char_table, n)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2437 Lisp_Object char_table, n;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2438 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2439 CHECK_CHAR_TABLE (char_table);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2440 CHECK_NUMBER (n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2441 if (XINT (n) < 0
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2442 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2443 args_out_of_range (char_table, n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2444
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2445 return XCHAR_TABLE (char_table)->extras[XINT (n)];
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2446 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2447
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2448 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2449 Sset_char_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2450 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2451 doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2452 (char_table, n, value)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2453 Lisp_Object char_table, n, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2454 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2455 CHECK_CHAR_TABLE (char_table);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2456 CHECK_NUMBER (n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2457 if (XINT (n) < 0
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2458 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2459 args_out_of_range (char_table, n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2460
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2461 return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2462 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2463
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2464 DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2465 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2466 doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2467 RANGE should be nil (for the default value)
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2468 a vector which identifies a character set or a row of a character set,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2469 a character set name, or a character code. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2470 (char_table, range)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2471 Lisp_Object char_table, range;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2472 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2473 CHECK_CHAR_TABLE (char_table);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2474
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2475 if (EQ (range, Qnil))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2476 return XCHAR_TABLE (char_table)->defalt;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2477 else if (INTEGERP (range))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2478 return Faref (char_table, range);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2479 else if (SYMBOLP (range))
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2480 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2481 Lisp_Object charset_info;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2482
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2483 charset_info = Fget (range, Qcharset);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2484 CHECK_VECTOR (charset_info);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2485
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2486 return Faref (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2487 make_number (XINT (XVECTOR (charset_info)->contents[0])
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2488 + 128));
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2489 }
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2490 else if (VECTORP (range))
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2491 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2492 if (XVECTOR (range)->size == 1)
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2493 return Faref (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2494 make_number (XINT (XVECTOR (range)->contents[0]) + 128));
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2495 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2496 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2497 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2498 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2499 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2500 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2501 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2502 return Faref (char_table, ch);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2503 }
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2504 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2505 else
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2506 error ("Invalid RANGE argument to `char-table-range'");
28666
3408e0502727 (syms_of_fns): Defsubr mapc.
Dave Love <fx@gnu.org>
parents: 28555
diff changeset
2507 return Qt;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2508 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2509
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2510 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2511 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2512 doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.
53259
ee40f6db9683 (Fset_char_table_range): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53255
diff changeset
2513 RANGE should be t (for all characters), nil (for the default value),
ee40f6db9683 (Fset_char_table_range): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53255
diff changeset
2514 a character set, a vector which identifies a character set, a row of a
ee40f6db9683 (Fset_char_table_range): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53255
diff changeset
2515 character set, or a character code. Return VALUE. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2516 (char_table, range, value)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2517 Lisp_Object char_table, range, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2518 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2519 int i;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2520
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2521 CHECK_CHAR_TABLE (char_table);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2522
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2523 if (EQ (range, Qt))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2524 for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2525 XCHAR_TABLE (char_table)->contents[i] = value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2526 else if (EQ (range, Qnil))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2527 XCHAR_TABLE (char_table)->defalt = value;
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2528 else if (SYMBOLP (range))
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2529 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2530 Lisp_Object charset_info;
53799
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2531 int charset_id;
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2532
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2533 charset_info = Fget (range, Qcharset);
53799
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2534 if (! VECTORP (charset_info)
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2535 || ! NATNUMP (AREF (charset_info, 0))
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2536 || (charset_id = XINT (AREF (charset_info, 0)),
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2537 ! CHARSET_DEFINED_P (charset_id)))
53821
7848629711b6 (Fset_char_table_range): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 53799
diff changeset
2538 error ("Invalid charset: %s", SDATA (SYMBOL_NAME (range)));
53799
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2539
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2540 if (charset_id == CHARSET_ASCII)
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2541 for (i = 0; i < 128; i++)
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2542 XCHAR_TABLE (char_table)->contents[i] = value;
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2543 else if (charset_id == CHARSET_8_BIT_CONTROL)
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2544 for (i = 128; i < 160; i++)
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2545 XCHAR_TABLE (char_table)->contents[i] = value;
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2546 else if (charset_id == CHARSET_8_BIT_GRAPHIC)
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2547 for (i = 160; i < 256; i++)
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2548 XCHAR_TABLE (char_table)->contents[i] = value;
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2549 else
9ddd570ce8c7 (Fset_char_table_range): Handle charsets ascii,
Kenichi Handa <handa@m17n.org>
parents: 53742
diff changeset
2550 XCHAR_TABLE (char_table)->contents[charset_id + 128] = value;
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2551 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2552 else if (INTEGERP (range))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2553 Faset (char_table, range, value);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2554 else if (VECTORP (range))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2555 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2556 if (XVECTOR (range)->size == 1)
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2557 return Faset (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2558 make_number (XINT (XVECTOR (range)->contents[0]) + 128),
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2559 value);
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2560 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2561 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2562 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2563 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2564 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2565 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2566 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2567 return Faset (char_table, ch, value);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2568 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2569 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2570 else
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2571 error ("Invalid RANGE argument to `set-char-table-range'");
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2572
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2573 return value;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2574 }
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2575
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2576 DEFUN ("set-char-table-default", Fset_char_table_default,
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2577 Sset_char_table_default, 3, 3, 0,
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2578 doc: /* Set the default value in CHAR-TABLE for generic character CH to VALUE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2579 The generic character specifies the group of characters.
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2580 See also the documentation of `make-char'. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2581 (char_table, ch, value)
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2582 Lisp_Object char_table, ch, value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2583 {
25709
ba4e2a641663 (SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents: 25690
diff changeset
2584 int c, charset, code1, code2;
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2585 Lisp_Object temp;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2586
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2587 CHECK_CHAR_TABLE (char_table);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2588 CHECK_NUMBER (ch);
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2589
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2590 c = XINT (ch);
24255
c373e786127a (Fset_char_table_default): To handle the case that CH is
Kenichi Handa <handa@m17n.org>
parents: 24016
diff changeset
2591 SPLIT_CHAR (c, charset, code1, code2);
22701
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2592
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2593 /* Since we may want to set the default value for a character set
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2594 not yet defined, we check only if the character set is in the
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2595 valid range or not, instead of it is already defined or not. */
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2596 if (! CHARSET_VALID_P (charset))
22706
27a8a6847be2 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 22701
diff changeset
2597 invalid_character (c);
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2598
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2599 if (charset == CHARSET_ASCII)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2600 return (XCHAR_TABLE (char_table)->defalt = value);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2601
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2602 /* Even if C is not a generic char, we had better behave as if a
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2603 generic char is specified. */
38483
eac29e9f6d99 * fns.c (Fset_char_table_default): Check that a charset is defined before checking its dimension.
Ken Raeburn <raeburn@raeburn.org>
parents: 37319
diff changeset
2604 if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1)
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2605 code1 = 0;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2606 temp = XCHAR_TABLE (char_table)->contents[charset + 128];
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2607 if (!code1)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2608 {
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2609 if (SUB_CHAR_TABLE_P (temp))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2610 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2611 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2612 XCHAR_TABLE (char_table)->contents[charset + 128] = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2613 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2614 }
35479
cb1dfadd1a18 (Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents: 35352
diff changeset
2615 if (SUB_CHAR_TABLE_P (temp))
cb1dfadd1a18 (Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents: 35352
diff changeset
2616 char_table = temp;
cb1dfadd1a18 (Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents: 35352
diff changeset
2617 else
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2618 char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
35479
cb1dfadd1a18 (Fset_char_table_default): Fix to make sub char-table correctly.
Kenichi Handa <handa@m17n.org>
parents: 35352
diff changeset
2619 = make_sub_char_table (temp));
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2620 temp = XCHAR_TABLE (char_table)->contents[code1];
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2621 if (SUB_CHAR_TABLE_P (temp))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2622 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2623 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2624 XCHAR_TABLE (char_table)->contents[code1] = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2625 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2626 }
21339
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2627
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2628 /* Look up the element in TABLE at index CH,
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2629 and return it as an integer.
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2630 If the element is nil, return CH itself.
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2631 (Actually we do that for any non-integer.) */
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2632
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2633 int
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2634 char_table_translate (table, ch)
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2635 Lisp_Object table;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2636 int ch;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2637 {
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2638 Lisp_Object value;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2639 value = Faref (table, make_number (ch));
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2640 if (! INTEGERP (value))
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2641 return ch;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2642 return XINT (value);
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2643 }
28222
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2644
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2645 static void
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2646 optimize_sub_char_table (table, chars)
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2647 Lisp_Object *table;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2648 int chars;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2649 {
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2650 Lisp_Object elt;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2651 int from, to;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2652
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2653 if (chars == 94)
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2654 from = 33, to = 127;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2655 else
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2656 from = 32, to = 128;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2657
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2658 if (!SUB_CHAR_TABLE_P (*table))
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2659 return;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2660 elt = XCHAR_TABLE (*table)->contents[from++];
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2661 for (; from < to; from++)
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2662 if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from])))
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2663 return;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2664 *table = elt;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2665 }
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2666
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2667 DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2668 1, 1, 0, doc: /* Optimize char table TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2669 (table)
28222
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2670 Lisp_Object table;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2671 {
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2672 Lisp_Object elt;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2673 int dim;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2674 int i, j;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2675
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2676 CHECK_CHAR_TABLE (table);
28222
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2677
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2678 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2679 {
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2680 elt = XCHAR_TABLE (table)->contents[i];
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2681 if (!SUB_CHAR_TABLE_P (elt))
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2682 continue;
33041
10bc9f620b67 (Foptimize_char_table): Fix arg for CHARSET_DIMENSION.
Kenichi Handa <handa@m17n.org>
parents: 32753
diff changeset
2683 dim = CHARSET_DIMENSION (i - 128);
28222
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2684 if (dim == 2)
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2685 for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2686 optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim);
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2687 optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, dim);
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2688 }
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2689 return Qnil;
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2690 }
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
2691
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2692
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2693 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2694 character or group of characters that share a value.
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2695 DEPTH is the current depth in the originally specified
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2696 chartable, and INDICES contains the vector indices
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2697 for the levels our callers have descended.
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2698
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2699 ARG is passed to C_FUNCTION when that is called. */
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2700
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2701 void
51032
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2702 map_char_table (c_function, function, table, subtable, arg, depth, indices)
20314
3fb425cf6a83 * fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents: 20148
diff changeset
2703 void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
51032
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2704 Lisp_Object function, table, subtable, arg, *indices;
16105
1712db4a1709 (map_char_table): Declare depth as int.
Richard M. Stallman <rms@gnu.org>
parents: 15966
diff changeset
2705 int depth;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2706 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2707 int i, to;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2708
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2709 if (depth == 0)
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2710 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2711 /* At first, handle ASCII and 8-bit European characters. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2712 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2713 {
51032
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2714 Lisp_Object elt= XCHAR_TABLE (subtable)->contents[i];
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2715 if (NILP (elt))
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2716 elt = XCHAR_TABLE (subtable)->defalt;
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2717 if (NILP (elt))
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2718 elt = Faref (subtable, make_number (i));
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2719 if (c_function)
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2720 (*c_function) (arg, make_number (i), elt);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2721 else
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2722 call2 (function, make_number (i), elt);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2723 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2724 #if 0 /* If the char table has entries for higher characters,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2725 we should report them. */
20148
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2726 if (NILP (current_buffer->enable_multibyte_characters))
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2727 return;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2728 #endif
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2729 to = CHAR_TABLE_ORDINARY_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2730 }
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2731 else
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2732 {
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2733 int charset = XFASTINT (indices[0]) - 128;
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2734
20148
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2735 i = 32;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2736 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2737 if (CHARSET_CHARS (charset) == 94)
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2738 i++, to--;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2739 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2740
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2741 for (; i < to; i++)
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2742 {
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2743 Lisp_Object elt;
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2744 int charset;
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2745
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2746 elt = XCHAR_TABLE (subtable)->contents[i];
18108
af791b0f0657 (map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents: 18035
diff changeset
2747 XSETFASTINT (indices[depth], i);
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2748 charset = XFASTINT (indices[0]) - 128;
29232
c0d6abd0b71b (map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents: 29010
diff changeset
2749 if (depth == 0
c0d6abd0b71b (map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents: 29010
diff changeset
2750 && (!CHARSET_DEFINED_P (charset)
c0d6abd0b71b (map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents: 29010
diff changeset
2751 || charset == CHARSET_8_BIT_CONTROL
c0d6abd0b71b (map_char_table): Ignore char-table entries for
Kenichi Handa <handa@m17n.org>
parents: 29010
diff changeset
2752 || charset == CHARSET_8_BIT_GRAPHIC))
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2753 continue;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2754
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2755 if (SUB_CHAR_TABLE_P (elt))
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2756 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2757 if (depth >= 3)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2758 error ("Too deep char table");
51032
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2759 map_char_table (c_function, function, table, elt, arg, depth + 1, indices);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2760 }
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2761 else
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2762 {
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2763 int c1, c2, c;
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2764
51038
0b084ee4c1c8 (map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 51032
diff changeset
2765 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
0b084ee4c1c8 (map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 51032
diff changeset
2766 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
0b084ee4c1c8 (map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 51032
diff changeset
2767 c = MAKE_CHAR (charset, c1, c2);
0b084ee4c1c8 (map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 51032
diff changeset
2768
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2769 if (NILP (elt))
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2770 elt = XCHAR_TABLE (subtable)->defalt;
51032
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2771 if (NILP (elt))
51038
0b084ee4c1c8 (map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 51032
diff changeset
2772 elt = Faref (table, make_number (c));
0b084ee4c1c8 (map_char_table): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 51032
diff changeset
2773
28962
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2774 if (c_function)
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2775 (*c_function) (arg, make_number (c), elt);
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2776 else
3f62d70df67c (map_char_table): Pay attention to character number of
Kenichi Handa <handa@m17n.org>
parents: 28666
diff changeset
2777 call2 (function, make_number (c), elt);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2778 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2779 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2780 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2781
49915
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2782 static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c));
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2783 static void
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2784 void_call2 (a, b, c)
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2785 Lisp_Object a, b, c;
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2786 {
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2787 call2 (a, b, c);
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2788 }
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2789
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2790 DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2791 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2792 doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2793 FUNCTION is called with two arguments--a key and a value.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2794 The key is always a possible IDX argument to `aref'. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2795 (function, char_table)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2796 Lisp_Object function, char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2797 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2798 /* The depth of char table is at most 3. */
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2799 Lisp_Object indices[3];
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2800
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2801 CHECK_CHAR_TABLE (char_table);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2802
49915
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2803 /* When Lisp_Object is represented as a union, `call2' cannot directly
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2804 be passed to map_char_table because it returns a Lisp_Object rather
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2805 than returning nothing.
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2806 Casting leads to crashes on some architectures. -stef */
51032
663da44e6176 (map_char_table): New arg TABLE gets the master table. All calls changed.
Richard M. Stallman <rms@gnu.org>
parents: 50461
diff changeset
2807 map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2808 return Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2809 }
30488
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2810
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2811 /* Return a value for character C in char-table TABLE. Store the
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2812 actual index for that value in *IDX. Ignore the default value of
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2813 TABLE. */
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2814
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2815 Lisp_Object
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2816 char_table_ref_and_index (table, c, idx)
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2817 Lisp_Object table;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2818 int c, *idx;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2819 {
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2820 int charset, c1, c2;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2821 Lisp_Object elt;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2822
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2823 if (SINGLE_BYTE_CHAR_P (c))
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2824 {
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2825 *idx = c;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2826 return XCHAR_TABLE (table)->contents[c];
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2827 }
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2828 SPLIT_CHAR (c, charset, c1, c2);
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2829 elt = XCHAR_TABLE (table)->contents[charset + 128];
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2830 *idx = MAKE_CHAR (charset, 0, 0);
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2831 if (!SUB_CHAR_TABLE_P (elt))
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2832 return elt;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2833 if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1]))
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2834 return XCHAR_TABLE (elt)->defalt;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2835 elt = XCHAR_TABLE (elt)->contents[c1];
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2836 *idx = MAKE_CHAR (charset, c1, 0);
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2837 if (!SUB_CHAR_TABLE_P (elt))
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2838 return elt;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2839 if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2]))
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2840 return XCHAR_TABLE (elt)->defalt;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2841 *idx = c;
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2842 return XCHAR_TABLE (elt)->contents[c2];
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2843 }
e26deb1d147a (char_table_ref_and_index): New function.
Kenichi Handa <handa@m17n.org>
parents: 30417
diff changeset
2844
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2845
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2846 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2847 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2848 nconc2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2849 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2850 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2851 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2852 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2853 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2854 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2855 return Fnconc (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2856 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2857 return Fnconc (2, &s1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2858 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2859 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2860
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2861 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
2862 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
2863 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
2864 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
2865 (nargs, args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2866 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2867 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2868 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2869 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2870 register Lisp_Object tail, tem, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2871
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2872 val = tail = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2873
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2874 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2875 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2876 tem = args[argnum];
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2877 if (NILP (tem)) continue;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2878
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2879 if (NILP (val))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2880 val = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2881
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2882 if (argnum + 1 == nargs) break;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2883
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2884 if (!CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2885 tem = wrong_type_argument (Qlistp, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2886
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2887 while (CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2888 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2889 tail = tem;
46221
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
2890 tem = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2891 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2892 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2893
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2894 tem = args[argnum + 1];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2895 Fsetcdr (tail, tem);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2896 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2897 args[argnum + 1] = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2898 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2899
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2900 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2901 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2902
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2903 /* 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
2904 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
2905 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
2906 LENI is the length of VALS, which should also be the length of SEQ. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2907
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2908 static void
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2909 mapcar1 (leni, vals, fn, seq)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2910 int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2911 Lisp_Object *vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2912 Lisp_Object fn, seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2913 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2914 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2915 Lisp_Object dummy;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2916 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2917 struct gcpro gcpro1, gcpro2, gcpro3;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2918
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2919 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2920 {
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2921 /* 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
2922 for (i = 0; i < leni; i++)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2923 vals[i] = Qnil;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2924
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2925 GCPRO3 (dummy, fn, seq);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2926 gcpro1.var = vals;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2927 gcpro1.nvars = leni;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2928 }
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2929 else
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2930 GCPRO2 (fn, seq);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2931 /* We need not explicitly protect `tail' because it is used only on lists, and
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2932 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2933
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2934 if (VECTORP (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2935 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2936 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2937 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2938 dummy = XVECTOR (seq)->contents[i];
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2939 dummy = call1 (fn, dummy);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2940 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2941 vals[i] = dummy;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2942 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2943 }
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2944 else if (BOOL_VECTOR_P (seq))
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2945 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2946 for (i = 0; i < leni; i++)
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2947 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2948 int byte;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2949 byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR];
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2950 if (byte & (1 << (i % BITS_PER_CHAR)))
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2951 dummy = Qt;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2952 else
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2953 dummy = Qnil;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2954
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2955 dummy = call1 (fn, dummy);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2956 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2957 vals[i] = dummy;
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2958 }
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2959 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2960 else if (STRINGP (seq))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2961 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2962 int i_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2963
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2964 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
2965 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2966 int c;
20712
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2967 int i_before = i;
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2968
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2969 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
2970 XSETFASTINT (dummy, c);
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2971 dummy = call1 (fn, dummy);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2972 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2973 vals[i_before] = dummy;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2974 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2975 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2976 else /* Must be a list, since Flength did not get an error */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2977 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2978 tail = seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2979 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2980 {
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2981 dummy = call1 (fn, Fcar (tail));
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2982 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2983 vals[i] = dummy;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2984 tail = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2985 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2986 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2987
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2988 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2989 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2990
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2991 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
2992 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
2993 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
2994 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
2995 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
2996 (function, sequence, separator)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2997 Lisp_Object function, sequence, separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2998 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2999 Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3000 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3001 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3002 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3003 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3004 struct gcpro gcpro1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3005
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
3006 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3007 leni = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3008 nargs = leni + leni - 1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3009 if (nargs < 0) return build_string ("");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3010
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3011 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3012
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
3013 GCPRO1 (separator);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
3014 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3015 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3016
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3017 for (i = leni - 1; i >= 0; i--)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3018 args[i + i] = args[i];
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3019
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3020 for (i = 1; i < nargs; i += 2)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
3021 args[i] = separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3022
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3023 return Fconcat (nargs, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3024 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3025
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3026 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
3027 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
3028 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
3029 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
3030 (function, sequence)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
3031 Lisp_Object function, sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3032 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3033 register Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3034 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3035 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3036
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
3037 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3038 leni = XFASTINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3039 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3040
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
3041 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3042
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3043 return Flist (leni, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3044 }
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3045
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3046 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
3047 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
3048 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
3049 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
3050 (function, sequence)
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3051 Lisp_Object function, sequence;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3052 {
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3053 register int leni;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3054
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3055 leni = XFASTINT (Flength (sequence));
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3056 mapcar1 (leni, 0, function, sequence);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3057
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3058 return sequence;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3059 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3060
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3061 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3062
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3063 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
3064 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
3065 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
3066 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
3067 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
3068 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
3069 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
3070 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
3071 `recenter', and `quit'.\)
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3072
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3073 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
3074 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
3075 (prompt)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3076 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3077 {
25071
31cd7d7a54df (Fy_or_n_p): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 25005
diff changeset
3078 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
3079 register int answer;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3080 Lisp_Object xprompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3081 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3082 struct gcpro gcpro1, gcpro2;
46293
1fb8f75062c6 Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents: 46221
diff changeset
3083 int count = SPECPDL_INDEX ();
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
3084
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
3085 specbind (Qcursor_in_echo_area, Qt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3086
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3087 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
3088
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3089 CHECK_STRING (prompt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3090 xprompt = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3091 GCPRO2 (prompt, xprompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3092
28072
713349e24825 (Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents: 27901
diff changeset
3093 #ifdef HAVE_X_WINDOWS
36256
e033d60bd048 Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents: 35513
diff changeset
3094 if (display_hourglass_p)
e033d60bd048 Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
parents: 35513
diff changeset
3095 cancel_hourglass ();
28072
713349e24825 (Fy_or_n_p): Cancel busy-cursor.
Gerd Moellmann <gerd@gnu.org>
parents: 27901
diff changeset
3096 #endif
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3097
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3098 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3099 {
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
3100
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
3101 #ifdef HAVE_MENUS
7790
75153e2d5d85 (Fy_or_n_p): Don't use dialog box if not an X frame.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
3102 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
3103 && 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
3104 && 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
3105 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
3106 Lisp_Object pane, menu;
35336
002c02db42d3 Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents: 34961
diff changeset
3107 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
3108 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
3109 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
3110 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
3111 menu = Fcons (prompt, pane);
6303
1571be153f56 (Fyes_or_no_p): Call Fx_popup_dialog instead of Fx_popup_menu.
Fred Pierresteguy <F.Pierresteguy@frcl.bull.fr>
parents: 6057
diff changeset
3112 obj = Fx_popup_dialog (Qt, menu);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
3113 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
3114 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
3115 }
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
3116 #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
3117 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
3118 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
3119
0626c87baa01 (Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents: 44219
diff changeset
3120 {
0626c87baa01 (Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents: 44219
diff changeset
3121 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
3122
45037
8fe017cea042 (Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents: 44760
diff changeset
3123 /* 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
3124 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
3125 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
3126 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
3127 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
3128 args[1] = xprompt;
0626c87baa01 (Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents: 44219
diff changeset
3129 Fmessage (2, args);
0626c87baa01 (Fy_or_n_p): Use `minibuffer-prompt' face for prompt.
Pavel Janík <Pavel@Janik.cz>
parents: 44219
diff changeset
3130 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3131
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3132 if (minibuffer_auto_raise)
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3133 {
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3134 Lisp_Object mini_frame;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3135
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3136 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3137
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3138 Fraise_frame (mini_frame);
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3139 }
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
3140
23057
2dbf1ec20bf7 (Fy_or_n_p): Don't bind input-method-function.
Richard M. Stallman <rms@gnu.org>
parents: 23051
diff changeset
3141 obj = read_filtered_event (1, 0, 0, 0);
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
3142 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
3143 /* 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
3144 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
3145
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3146 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
3147 def = Flookup_key (map, key, Qt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3148
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3149 if (EQ (def, intern ("skip")))
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3150 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3151 answer = 0;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3152 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3153 }
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3154 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
3155 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3156 answer = 1;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3157 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3158 }
2311
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
3159 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
3160 {
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
3161 Frecenter (Qnil);
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
3162 xprompt = prompt;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
3163 continue;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
3164 }
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3165 else if (EQ (def, intern ("quit")))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3166 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
3167 /* 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
3168 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
3169 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
3170 Vquit_flag = Qt;
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3171
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3172 QUIT;
1194
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
3173
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
3174 /* If we don't clear this, then the next call to read_char will
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
3175 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
3176 Vquit_flag = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3177
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3178 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3179 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3180 if (EQ (xprompt, prompt))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3181 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3182 args[0] = build_string ("Please answer y or n. ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3183 args[1] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3184 xprompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3185 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3186 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3187 UNGCPRO;
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
3188
2525
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
3189 if (! noninteractive)
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
3190 {
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
3191 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
3192 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
3193 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
3194 }
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
3195
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
3196 unbind_to (count, Qnil);
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
3197 return answer ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3198 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3199
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3200 /* This is how C code calls `yes-or-no-p' and allows the user
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3201 to redefined it.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3202
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3203 Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3204
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3205 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3206 do_yes_or_no_p (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3207 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3208 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3209 return call1 (intern ("yes-or-no-p"), prompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3210 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3212 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3213
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3214 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
3215 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
3216 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
3217 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
3218 The user must confirm the answer with RET,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3219 and can edit it until it has been confirmed.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3220
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3221 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
3222 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
3223 (prompt)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3224 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3225 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3226 register Lisp_Object ans;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3227 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3228 struct gcpro gcpro1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3229
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3230 CHECK_STRING (prompt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3231
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
3232 #ifdef HAVE_MENUS
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3233 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
3234 && 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
3235 && 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
3236 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
3237 Lisp_Object pane, menu, obj;
35336
002c02db42d3 Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents: 34961
diff changeset
3238 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
3239 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
3240 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
3241 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
3242 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
3243 menu = Fcons (prompt, pane);
6344
4ef6b636dc99 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 6303
diff changeset
3244 obj = Fx_popup_dialog (Qt, menu);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
3245 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
3246 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
3247 }
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
3248 #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
3249
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3250 args[0] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3251 args[1] = build_string ("(yes or no) ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3252 prompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3253
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3254 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
3255
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3256 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3257 {
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
3258 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
3259 Qyes_or_no_p_history, Qnil,
6d3cc8864678 (Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents: 19383
diff changeset
3260 Qnil));
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3261 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes"))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3262 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3263 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3264 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3265 }
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3266 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no"))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3267 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3268 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3269 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3270 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3271
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3272 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3273 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3274 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
3275 Fsleep_for (make_number (2), Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3276 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3277 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3278
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3279 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
3280 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
3281
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3282 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
3283 to integer.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3284
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3285 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
3286 These floats are not multiplied by 100.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3287
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3288 If the 5-minute or 15-minute load averages are not available, return a
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3289 shortened list, containing only those averages which are available.
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3290
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3291 An error is thrown if the load average can't be obtained. In some
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3292 cases making it work would require Emacs being installed setuid or
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3293 setgid so that it can read kernel information, and that usually isn't
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3294 advisable. */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3295 (use_floats)
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3296 Lisp_Object use_floats;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3297 {
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
3298 double load_ave[3];
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
3299 int loads = getloadavg (load_ave, 3);
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3300 Lisp_Object ret = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3301
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
3302 if (loads < 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
3303 error ("load-average not implemented for this operating system");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3304
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3305 while (loads-- > 0)
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3306 {
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3307 Lisp_Object load = (NILP (use_floats) ?
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3308 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
3309 : make_float (load_ave[loads]));
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3310 ret = Fcons (load, ret);
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
3311 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3312
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
3313 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3314 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3315
39968
51a89919bc4e (Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents: 39956
diff changeset
3316 Lisp_Object Vfeatures, Qsubfeatures;
51a89919bc4e (Vafter_load_alist): Declare extern (w32 build problem).
Sam Steingold <sds@gnu.org>
parents: 39956
diff changeset
3317 extern Lisp_Object Vafter_load_alist;
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3318
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3319 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
3320 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
3321
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3322 Use this to conditionalize execution of lisp code based on the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3323 presence or absence of emacs or environment extensions.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3324 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
3325 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
3326 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
3327 (feature, subfeature)
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3328 Lisp_Object feature, subfeature;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3329 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3330 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
3331 CHECK_SYMBOL (feature);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3332 tem = Fmemq (feature, Vfeatures);
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3333 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
3334 tem = Fmember (subfeature, Fget (feature, Qsubfeatures));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
3335 return (NILP (tem)) ? Qnil : Qt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3336 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3337
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3338 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
3339 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
3340 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
3341 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
3342 (feature, subfeatures)
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3343 Lisp_Object feature, subfeatures;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3344 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3345 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
3346 CHECK_SYMBOL (feature);
44066
d0bef01f3cb3 (Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents: 41006
diff changeset
3347 CHECK_LIST (subfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
3348 if (!NILP (Vautoload_queue))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3349 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3350 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
3351 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3352 Vfeatures = Fcons (feature, Vfeatures);
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3353 if (!NILP (subfeatures))
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3354 Fput (feature, Qsubfeatures, subfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
3355 LOADHIST_ATTACH (Fcons (Qprovide, feature));
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3356
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3357 /* Run any load-hooks for this file. */
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3358 tem = Fassq (feature, Vafter_load_alist);
46221
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
3359 if (CONSP (tem))
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
3360 Fprogn (XCDR (tem));
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
3361
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3362 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3363 }
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3364
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3365 /* `require' and its subroutines. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3366
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3367 /* 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
3368
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3369 Lisp_Object require_nesting_list;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3370
40550
56075abda301 (require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents: 40474
diff changeset
3371 Lisp_Object
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3372 require_unwind (old_value)
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3373 Lisp_Object old_value;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3374 {
40550
56075abda301 (require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents: 40474
diff changeset
3375 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
3376 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3377
23733
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
3378 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
3379 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
3380 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
3381 is not loaded; so load the file FILENAME.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3382 If FILENAME is omitted, the printname of FEATURE is used as the file name,
52766
ada153c6900b (Frequire): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 52401
diff changeset
3383 and `load' will try to load this name appended with the suffix `.elc' or
ada153c6900b (Frequire): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 52401
diff changeset
3384 `.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
3385 If the optional third argument NOERROR is non-nil,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3386 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
3387 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
3388 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
3389 (feature, filename, noerror)
37208
34075f64de15 (Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents: 36890
diff changeset
3390 Lisp_Object feature, filename, noerror;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3391 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3392 register Lisp_Object tem;
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3393 struct gcpro gcpro1, gcpro2;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3394
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3395 CHECK_SYMBOL (feature);
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3396
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3397 tem = Fmemq (feature, Vfeatures);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
3398
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
3399 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3400 {
46293
1fb8f75062c6 Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents: 46221
diff changeset
3401 int count = SPECPDL_INDEX ();
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3402 int nesting = 0;
45037
8fe017cea042 (Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents: 44760
diff changeset
3403
48596
65f924c09e6d (Frequire): Don't call LOADHIST_ATTACH if feature was
Dave Love <fx@gnu.org>
parents: 48567
diff changeset
3404 LOADHIST_ATTACH (Fcons (Qrequire, feature));
65f924c09e6d (Frequire): Don't call LOADHIST_ATTACH if feature was
Dave Love <fx@gnu.org>
parents: 48567
diff changeset
3405
45039
ed0ad59e4ec7 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 45037
diff changeset
3406 /* This is to make sure that loadup.el gives a clear picture
ed0ad59e4ec7 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 45037
diff changeset
3407 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
3408 if (! NILP (Vpurify_flag))
8fe017cea042 (Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents: 44760
diff changeset
3409 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
3410 SDATA (SYMBOL_NAME (feature)));
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
3411
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3412 /* 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
3413 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
3414 signal an error. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3415 tem = require_nesting_list;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3416 while (! NILP (tem))
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3417 {
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3418 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
3419 nesting++;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3420 tem = XCDR (tem);
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3421 }
48567
ecf43ac20827 fns.c (Frequire): Change nesting allowance from 2 to 3 to cause more
Steven Tamm <steventamm@mac.com>
parents: 48337
diff changeset
3422 if (nesting > 3)
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3423 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
3424 SDATA (SYMBOL_NAME (feature)));
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3425
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3426 /* 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
3427 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
3428 require_nesting_list = Fcons (feature, require_nesting_list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3429
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3430 /* Value saved here is to be restored into Vautoload_queue */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3431 record_unwind_protect (un_autoload, Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3432 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3433
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3434 /* Load the file. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3435 GCPRO2 (feature, filename);
37208
34075f64de15 (Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents: 36890
diff changeset
3436 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
3437 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
3438 UNGCPRO;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3439
23733
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
3440 /* If load failed entirely, return nil. */
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
3441 if (NILP (tem))
24016
43344f47a865 (Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents: 23927
diff changeset
3442 return unbind_to (count, Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3443
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3444 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
3445 if (NILP (tem))
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3446 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
3447 SDATA (SYMBOL_NAME (feature)));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3448
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3449 /* Once loading finishes, don't undo it. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3450 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3451 feature = unbind_to (count, feature);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3452 }
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
3453
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3454 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3455 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3456
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3457 /* Primitives for work of the "widget" library.
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3458 In an ideal world, this section would not have been necessary.
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3459 However, lisp function calls being as slow as they are, it turns
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3460 out that some functions in the widget library (wid-edit.el) are the
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3461 bottleneck of Widget operation. Here is their translation to C,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3462 for the sole reason of efficiency. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3463
29953
dad7b11391a3 (Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29809
diff changeset
3464 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
3465 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
3466 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
3467 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3468 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
3469 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
3470 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
3471 (plist, prop)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3472 Lisp_Object plist, prop;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3473 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3474 while (CONSP (plist) && !EQ (XCAR (plist), prop))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3475 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3476 QUIT;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3477 plist = XCDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3478 plist = CDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3479 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3480 return plist;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3481 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3482
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3483 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
3484 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
3485 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
3486 (widget, property, value)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3487 Lisp_Object widget, property, value;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3488 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3489 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
3490 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
3491 return value;
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3492 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3493
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3494 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
3495 doc: /* In WIDGET, get the value of PROPERTY.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3496 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
3497 later with `widget-put'. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3498 (widget, property)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3499 Lisp_Object widget, property;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3500 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3501 Lisp_Object tmp;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3502
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3503 while (1)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3504 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3505 if (NILP (widget))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3506 return Qnil;
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3507 CHECK_CONS (widget);
29953
dad7b11391a3 (Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29809
diff changeset
3508 tmp = Fplist_member (XCDR (widget), property);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3509 if (CONSP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3510 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3511 tmp = XCDR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3512 return CAR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3513 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3514 tmp = XCAR (widget);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3515 if (NILP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3516 return Qnil;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3517 widget = Fget (tmp, Qwidget_type);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3518 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3519 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3520
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3521 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
3522 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
3523 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
3524 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
3525 (nargs, args)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3526 int nargs;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3527 Lisp_Object *args;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3528 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3529 /* This function can GC. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3530 Lisp_Object newargs[3];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3531 struct gcpro gcpro1, gcpro2;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3532 Lisp_Object result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3533
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3534 newargs[0] = Fwidget_get (args[0], args[1]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3535 newargs[1] = args[0];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3536 newargs[2] = Flist (nargs - 2, args + 2);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3537 GCPRO2 (newargs[0], newargs[2]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3538 result = Fapply (3, newargs);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3539 UNGCPRO;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3540 return result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3541 }
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3542
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3543 #ifdef HAVE_LANGINFO_CODESET
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3544 #include <langinfo.h>
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3545 #endif
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3546
51976
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
3547 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
3548 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
3549 ITEM should be one of the following:
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3550
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
3551 `codeset', returning the character set as a string (locale item CODESET);
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3552
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
3553 `days', returning a 7-element vector of day names (locale items DAY_n);
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3554
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
3555 `months', returning a 12-element vector of month names (locale items MON_n);
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3556
51976
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
3557 `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
3558 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
3559
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3560 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
3561 `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
3562
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
3563 See also Info node `(libc)Locales'.
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
3564
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3565 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
3566 (item)
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3567 Lisp_Object item;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3568 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3569 char *str = NULL;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3570 #ifdef HAVE_LANGINFO_CODESET
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3571 Lisp_Object val;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3572 if (EQ (item, Qcodeset))
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3573 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3574 str = nl_langinfo (CODESET);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3575 return build_string (str);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3576 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3577 #ifdef DAY_1
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3578 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
3579 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3580 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
3581 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
3582 int i;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3583 synchronize_system_time_locale ();
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3584 for (i = 0; i < 7; i++)
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3585 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3586 str = nl_langinfo (days[i]);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3587 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
3588 /* 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
3589 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
3590 Faset (v, make_number (i),
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3591 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
3592 0));
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3593 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3594 return v;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3595 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3596 #endif /* DAY_1 */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3597 #ifdef MON_1
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3598 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
3599 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3600 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
3601 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
3602 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
3603 int i;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3604 synchronize_system_time_locale ();
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3605 for (i = 0; i < 12; i++)
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3606 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3607 str = nl_langinfo (months[i]);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3608 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
3609 p->contents[i] =
49915
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
3610 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
3611 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3612 XSETVECTOR (val, p);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3613 return val;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3614 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3615 #endif /* MON_1 */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3616 /* 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
3617 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
3618 #ifdef PAPER_WIDTH
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3619 else if (EQ (item, Qpaper))
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3620 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3621 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
3622 make_number (nl_langinfo (PAPER_HEIGHT)));
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3623 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3624 #endif /* PAPER_WIDTH */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3625 #endif /* HAVE_LANGINFO_CODESET*/
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
3626 return Qnil;
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
3627 }
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
3628
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
3629 /* 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
3630 Based on code from GNU recode. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3631
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3632 #define MIME_LINE_LENGTH 76
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3633
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3634 #define IS_ASCII(Character) \
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3635 ((Character) < 128)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3636 #define IS_BASE64(Character) \
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3637 (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
3638 #define IS_BASE64_IGNORABLE(Character) \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3639 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3640 || (Character) == '\f' || (Character) == '\r')
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3641
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3642 /* 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
3643 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
3644 process. */
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3645 #define READ_QUADRUPLET_BYTE(retval) \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3646 do \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3647 { \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3648 if (i == length) \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3649 { \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3650 if (nchars_return) \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3651 *nchars_return = nchars; \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3652 return (retval); \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3653 } \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3654 c = from[i++]; \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3655 } \
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3656 while (IS_BASE64_IGNORABLE (c))
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3657
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3658 /* Don't use alloca for regions larger than this, lest we overflow
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3659 their stack. */
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3660 #define MAX_ALLOCA 16*1024
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3661
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3662 /* 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
3663 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
3664 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3665 '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
3666 '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
3667 '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
3668 '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
3669 '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
3670 '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
3671 '8', '9', '+', '/' /* 60-63 */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3672 };
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3673
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3674 /* 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
3675 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
3676 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3677 -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
3678 -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
3679 -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
3680 -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
3681 -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
3682 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
3683 -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
3684 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
3685 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
3686 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
3687 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
3688 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
3689 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
3690 };
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3691
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3692 /* 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
3693 get transformed into four base64 characters.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3694
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3695 .--------. .--------. .--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3696 |aaaaaabb| |bbbbcccc| |ccdddddd|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3697 `--------' `--------' `--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3698 6 2 4 4 2 6
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3699 .--------+--------+--------+--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3700 |00aaaaaa|00bbbbbb|00cccccc|00dddddd|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3701 `--------+--------+--------+--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3702
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3703 .--------+--------+--------+--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3704 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3705 `--------+--------+--------+--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3706
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3707 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
3708 base64 characters. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3709
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3710
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3711 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
3712 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
3713
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3714 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
3715 2, 3, "r",
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3716 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
3717 Return the length of the encoded text.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3718 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
3719 into shorter lines. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3720 (beg, end, no_line_break)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3721 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
3722 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3723 char *encoded;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3724 int allength, length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3725 int ibeg, iend, encoded_length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3726 int old_pos = PT;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3727
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3728 validate_region (&beg, &end);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3729
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3730 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3731 iend = CHAR_TO_BYTE (XFASTINT (end));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3732 move_gap_both (XFASTINT (beg), ibeg);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3733
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3734 /* 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
3735 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
3736 characters, and then we round up. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3737 length = iend - ibeg;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3738 allength = length + length/3 + 1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3739 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
3740
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3741 if (allength <= MAX_ALLOCA)
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3742 encoded = (char *) alloca (allength);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3743 else
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3744 encoded = (char *) xmalloc (allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3745 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
3746 NILP (no_line_break),
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3747 !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
3748 if (encoded_length > allength)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3749 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3750
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3751 if (encoded_length < 0)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3752 {
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3753 /* The encoding wasn't possible. */
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3754 if (length > MAX_ALLOCA)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3755 xfree (encoded);
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
3756 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
3757 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3758
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3759 /* 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
3760 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
3761 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
3762 insert (encoded, encoded_length);
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3763 if (allength > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3764 xfree (encoded);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3765 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
3766
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3767 /* 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
3768 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
3769 if (old_pos >= XFASTINT (end))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3770 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
3771 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
3772 old_pos = XFASTINT (beg);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3773 SET_PT (old_pos);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3774
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3775 /* 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
3776 return make_number (encoded_length);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3777 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3778
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3779 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
3780 1, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3781 doc: /* Base64-encode STRING and return the result.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3782 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
3783 into shorter lines. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3784 (string, no_line_break)
24377
f881dd22ec7d (Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents: 24334
diff changeset
3785 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
3786 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3787 int allength, length, encoded_length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3788 char *encoded;
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3789 Lisp_Object encoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3790
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3791 CHECK_STRING (string);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3792
24437
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3793 /* 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
3794 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
3795 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
3796 length = SBYTES (string);
24437
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3797 allength = length + length/3 + 1;
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3798 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
3799
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3800 /* We need to allocate enough room for decoding the text. */
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3801 if (allength <= MAX_ALLOCA)
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3802 encoded = (char *) alloca (allength);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3803 else
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3804 encoded = (char *) xmalloc (allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3805
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3806 encoded_length = base64_encode_1 (SDATA (string),
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3807 encoded, length, NILP (no_line_break),
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3808 STRING_MULTIBYTE (string));
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3809 if (encoded_length > allength)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3810 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3811
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3812 if (encoded_length < 0)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3813 {
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3814 /* The encoding wasn't possible. */
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3815 if (length > MAX_ALLOCA)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3816 xfree (encoded);
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
3817 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
3818 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3819
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3820 encoded_string = make_unibyte_string (encoded, encoded_length);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3821 if (allength > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3822 xfree (encoded);
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3823
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3824 return encoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3825 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3826
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3827 static int
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3828 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
3829 const char *from;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3830 char *to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3831 int length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3832 int line_break;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3833 int multibyte;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3834 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3835 int counter = 0, i = 0;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3836 char *e = to;
31865
dd9aa7db6710 (base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents: 31842
diff changeset
3837 int c;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3838 unsigned int value;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3839 int bytes;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3840
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3841 while (i < length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3842 {
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3843 if (multibyte)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3844 {
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3845 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3846 if (c >= 256)
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3847 return -1;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3848 i += bytes;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3849 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3850 else
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3851 c = from[i++];
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3852
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3853 /* Wrap line every 76 characters. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3854
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3855 if (line_break)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3856 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3857 if (counter < MIME_LINE_LENGTH / 4)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3858 counter++;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3859 else
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3860 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3861 *e++ = '\n';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3862 counter = 1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3863 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3864 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3865
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3866 /* Process first byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3867
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3868 *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
3869 value = (0x03 & c) << 4;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3870
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3871 /* Process second byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3872
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3873 if (i == length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3874 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3875 *e++ = base64_value_to_char[value];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3876 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3877 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3878 break;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3879 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3880
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3881 if (multibyte)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3882 {
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3883 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3884 if (c >= 256)
31865
dd9aa7db6710 (base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents: 31842
diff changeset
3885 return -1;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3886 i += bytes;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3887 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3888 else
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3889 c = from[i++];
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3890
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3891 *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
3892 value = (0x0f & c) << 2;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3893
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3894 /* Process third byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3895
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3896 if (i == length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3897 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3898 *e++ = base64_value_to_char[value];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3899 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3900 break;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3901 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3902
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3903 if (multibyte)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3904 {
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3905 c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3906 if (c >= 256)
31865
dd9aa7db6710 (base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents: 31842
diff changeset
3907 return -1;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3908 i += bytes;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3909 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3910 else
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3911 c = from[i++];
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3912
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3913 *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
3914 *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
3915 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3916
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3917 return e - to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3918 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3919
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3920
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3921 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
3922 2, 2, "r",
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3923 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
3924 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
3925 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
3926 (beg, end)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3927 Lisp_Object beg, end;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3928 {
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3929 int ibeg, iend, length, allength;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3930 char *decoded;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3931 int old_pos = PT;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3932 int decoded_length;
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3933 int inserted_chars;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3934 int multibyte = !NILP (current_buffer->enable_multibyte_characters);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3935
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3936 validate_region (&beg, &end);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3937
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3938 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3939 iend = CHAR_TO_BYTE (XFASTINT (end));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3940
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3941 length = iend - ibeg;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3942
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3943 /* 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
3944 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
3945 most two bytes. */
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3946 allength = multibyte ? length * 2 : length;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3947 if (allength <= MAX_ALLOCA)
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3948 decoded = (char *) alloca (allength);
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3949 else
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3950 decoded = (char *) xmalloc (allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3951
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3952 move_gap_both (XFASTINT (beg), ibeg);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3953 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
3954 multibyte, &inserted_chars);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3955 if (decoded_length > allength)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3956 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3957
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3958 if (decoded_length < 0)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3959 {
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3960 /* The decoding wasn't possible. */
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3961 if (allength > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3962 xfree (decoded);
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
3963 error ("Invalid base64 data");
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3964 }
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3965
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3966 /* 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
3967 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
3968 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3969 insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3970 if (allength > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3971 xfree (decoded);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3972 /* Delete the original text. */
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3973 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
3974 iend + decoded_length, 1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3975
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3976 /* 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
3977 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
3978 if (old_pos >= XFASTINT (end))
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3979 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
3980 else if (old_pos > XFASTINT (beg))
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3981 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
3982 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
3983
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3984 return make_number (inserted_chars);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3985 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3986
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3987 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
3988 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3989 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
3990 (string)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3991 Lisp_Object string;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3992 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3993 char *decoded;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3994 int length, decoded_length;
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3995 Lisp_Object decoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3996
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3997 CHECK_STRING (string);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3998
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3999 length = SBYTES (string);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4000 /* We need to allocate enough room for decoding the text. */
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
4001 if (length <= MAX_ALLOCA)
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
4002 decoded = (char *) alloca (length);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
4003 else
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
4004 decoded = (char *) xmalloc (length);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4005
32753
401f661f11d4 2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 32351
diff changeset
4006 /* 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
4007 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
4008 0, NULL);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4009 if (decoded_length > length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4010 abort ();
28493
9ffea423a7b0 (Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents: 28481
diff changeset
4011 else if (decoded_length >= 0)
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
4012 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
4013 else
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
4014 decoded_string = Qnil;
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
4015
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
4016 if (length > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
4017 xfree (decoded);
28493
9ffea423a7b0 (Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents: 28481
diff changeset
4018 if (!STRINGP (decoded_string))
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
4019 error ("Invalid base64 data");
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
4020
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
4021 return decoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4022 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4023
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4024 /* Base64-decode the data at FROM of LENGHT bytes into TO. If
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4025 MULTIBYTE is nonzero, the decoded result should be in multibyte
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4026 form. If NCHARS_RETRUN is not NULL, store the number of produced
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4027 characters in *NCHARS_RETURN. */
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4028
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4029 static int
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4030 base64_decode_1 (from, to, length, multibyte, nchars_return)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4031 const char *from;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4032 char *to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4033 int length;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4034 int multibyte;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4035 int *nchars_return;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4036 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4037 int i = 0;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4038 char *e = to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4039 unsigned char c;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4040 unsigned long value;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4041 int nchars = 0;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4042
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4043 while (1)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4044 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4045 /* Process first byte of a quadruplet. */
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4046
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4047 READ_QUADRUPLET_BYTE (e-to);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4048
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4049 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4050 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4051 value = base64_char_to_value[c] << 18;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4052
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4053 /* Process second byte of a quadruplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4054
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4055 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4056
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4057 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4058 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4059 value |= base64_char_to_value[c] << 12;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4060
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4061 c = (unsigned char) (value >> 16);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4062 if (multibyte)
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4063 e += CHAR_STRING (c, e);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4064 else
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4065 *e++ = c;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4066 nchars++;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4067
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4068 /* Process third byte of a quadruplet. */
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4069
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4070 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4071
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4072 if (c == '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4073 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4074 READ_QUADRUPLET_BYTE (-1);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4075
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4076 if (c != '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4077 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4078 continue;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4079 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4080
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4081 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4082 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4083 value |= base64_char_to_value[c] << 6;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4084
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4085 c = (unsigned char) (0xff & value >> 8);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4086 if (multibyte)
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4087 e += CHAR_STRING (c, e);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4088 else
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4089 *e++ = c;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4090 nchars++;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4091
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4092 /* Process fourth byte of a quadruplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4093
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
4094 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4095
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4096 if (c == '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4097 continue;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4098
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4099 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4100 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4101 value |= base64_char_to_value[c];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4102
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4103 c = (unsigned char) (0xff & value);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4104 if (multibyte)
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4105 e += CHAR_STRING (c, e);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4106 else
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4107 *e++ = c;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
4108 nchars++;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4109 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4110 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4111
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4112
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4113
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4114 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4115 ***** *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4116 ***** Hash Tables *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4117 ***** *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4118 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4119
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4120 /* Implemented by gerd@gnu.org. This hash table implementation was
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4121 inspired by CMUCL hash tables. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4122
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4123 /* Ideas:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4124
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4125 1. For small tables, association lists are probably faster than
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4126 hash tables because they have lower overhead.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4127
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4128 For uses of hash tables where the O(1) behavior of table
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4129 operations is not a requirement, it might therefore be a good idea
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4130 not to hash. Instead, we could just do a linear search in the
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4131 key_and_value vector of the hash table. This could be done
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4132 if a `:linear-search t' argument is given to make-hash-table. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4133
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4134
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4135 /* The list of all weak hash tables. Don't staticpro this one. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4136
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4137 Lisp_Object Vweak_hash_tables;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4138
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4139 /* Various symbols. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4140
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4141 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue;
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4142 Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4143 Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4144
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4145 /* Function prototypes. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4146
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4147 static struct Lisp_Hash_Table *check_hash_table P_ ((Lisp_Object));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4148 static int get_key_arg P_ ((Lisp_Object, int, Lisp_Object *, char *));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4149 static void maybe_resize_hash_table P_ ((struct Lisp_Hash_Table *));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4150 static int cmpfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4151 Lisp_Object, unsigned));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4152 static int cmpfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4153 Lisp_Object, unsigned));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4154 static int cmpfn_user_defined P_ ((struct Lisp_Hash_Table *, Lisp_Object,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4155 unsigned, Lisp_Object, unsigned));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4156 static unsigned hashfn_eq P_ ((struct Lisp_Hash_Table *, Lisp_Object));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4157 static unsigned hashfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4158 static unsigned hashfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4159 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4160 Lisp_Object));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4161 static unsigned sxhash_string P_ ((unsigned char *, int));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4162 static unsigned sxhash_list P_ ((Lisp_Object, int));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4163 static unsigned sxhash_vector P_ ((Lisp_Object, int));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4164 static unsigned sxhash_bool_vector P_ ((Lisp_Object));
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4165 static int sweep_weak_table P_ ((struct Lisp_Hash_Table *, int));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4166
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4167
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4168
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4169 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4170 Utilities
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4171 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4172
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4173 /* If OBJ is a Lisp hash table, return a pointer to its struct
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4174 Lisp_Hash_Table. Otherwise, signal an error. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4175
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4176 static struct Lisp_Hash_Table *
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4177 check_hash_table (obj)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4178 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4179 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
4180 CHECK_HASH_TABLE (obj);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4181 return XHASH_TABLE (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4182 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4183
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4184
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4185 /* Value is the next integer I >= N, N >= 0 which is "almost" a prime
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4186 number. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4187
29979
6fe8f444b6a3 (next_almost_prime): Make it externally visible.
Gerd Moellmann <gerd@gnu.org>
parents: 29953
diff changeset
4188 int
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4189 next_almost_prime (n)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4190 int n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4191 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4192 if (n % 2 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4193 n += 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4194 if (n % 3 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4195 n += 2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4196 if (n % 7 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4197 n += 4;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4198 return n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4199 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4200
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4201
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4202 /* Find KEY in ARGS which has size NARGS. Don't consider indices for
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4203 which USED[I] is non-zero. If found at index I in ARGS, set
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4204 USED[I] and USED[I + 1] to 1, and return I + 1. Otherwise return
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4205 -1. This function is used to extract a keyword/argument pair from
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4206 a DEFUN parameter list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4207
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4208 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4209 get_key_arg (key, nargs, args, used)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4210 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4211 int nargs;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4212 Lisp_Object *args;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4213 char *used;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4214 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4215 int i;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4216
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4217 for (i = 0; i < nargs - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4218 if (!used[i] && EQ (args[i], key))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4219 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4220
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4221 if (i >= nargs - 1)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4222 i = -1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4223 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4224 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4225 used[i++] = 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4226 used[i] = 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4227 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4228
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4229 return i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4230 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4231
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4232
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4233 /* Return a Lisp vector which has the same contents as VEC but has
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4234 size NEW_SIZE, NEW_SIZE >= VEC->size. Entries in the resulting
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4235 vector that are not copied from VEC are set to INIT. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4236
28481
3caab3235bc1 (larger_vector): Make externally visible.
Gerd Moellmann <gerd@gnu.org>
parents: 28222
diff changeset
4237 Lisp_Object
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4238 larger_vector (vec, new_size, init)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4239 Lisp_Object vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4240 int new_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4241 Lisp_Object init;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4242 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4243 struct Lisp_Vector *v;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4244 int i, old_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4245
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4246 xassert (VECTORP (vec));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4247 old_size = XVECTOR (vec)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4248 xassert (new_size >= old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4249
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
4250 v = allocate_vector (new_size);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4251 bcopy (XVECTOR (vec)->contents, v->contents,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4252 old_size * sizeof *v->contents);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4253 for (i = old_size; i < new_size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4254 v->contents[i] = init;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4255 XSETVECTOR (vec, v);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4256 return vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4257 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4258
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4259
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4260 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4261 Low-level Functions
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4262 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4263
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4264 /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4265 HASH2 in hash table H using `eql'. Value is non-zero if KEY1 and
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4266 KEY2 are the same. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4267
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4268 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4269 cmpfn_eql (h, key1, hash1, key2, hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4270 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4271 Lisp_Object key1, key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4272 unsigned hash1, hash2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4273 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4274 return (FLOATP (key1)
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4275 && FLOATP (key2)
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
4276 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4277 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4278
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4279
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4280 /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4281 HASH2 in hash table H using `equal'. Value is non-zero if KEY1 and
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4282 KEY2 are the same. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4283
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4284 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4285 cmpfn_equal (h, key1, hash1, key2, hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4286 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4287 Lisp_Object key1, key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4288 unsigned hash1, hash2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4289 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4290 return hash1 == hash2 && !NILP (Fequal (key1, key2));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4291 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4292
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4293
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4294 /* Compare KEY1 which has hash code HASH1, and KEY2 with hash code
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4295 HASH2 in hash table H using H->user_cmp_function. Value is non-zero
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4296 if KEY1 and KEY2 are the same. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4297
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4298 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4299 cmpfn_user_defined (h, key1, hash1, key2, hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4300 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4301 Lisp_Object key1, key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4302 unsigned hash1, hash2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4303 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4304 if (hash1 == hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4305 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4306 Lisp_Object args[3];
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4307
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4308 args[0] = h->user_cmp_function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4309 args[1] = key1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4310 args[2] = key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4311 return !NILP (Ffuncall (3, args));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4312 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4313 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4314 return 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4315 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4316
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4317
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4318 /* Value is a hash code for KEY for use in hash table H which uses
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4319 `eq' to compare keys. The hash code returned is guaranteed to fit
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4320 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4321
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4322 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4323 hashfn_eq (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4324 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4325 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4326 {
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4327 unsigned hash = XUINT (key) ^ XGCTYPE (key);
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4328 xassert ((hash & ~INTMASK) == 0);
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4329 return hash;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4330 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4331
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4332
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4333 /* Value is a hash code for KEY for use in hash table H which uses
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4334 `eql' to compare keys. The hash code returned is guaranteed to fit
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4335 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4336
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4337 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4338 hashfn_eql (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4339 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4340 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4341 {
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4342 unsigned hash;
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4343 if (FLOATP (key))
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4344 hash = sxhash (key, 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4345 else
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4346 hash = XUINT (key) ^ XGCTYPE (key);
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4347 xassert ((hash & ~INTMASK) == 0);
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4348 return hash;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4349 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4350
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4351
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4352 /* Value is a hash code for KEY for use in hash table H which uses
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4353 `equal' to compare keys. The hash code returned is guaranteed to fit
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4354 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4355
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4356 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4357 hashfn_equal (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4358 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4359 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4360 {
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4361 unsigned hash = sxhash (key, 0);
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4362 xassert ((hash & ~INTMASK) == 0);
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4363 return hash;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4364 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4365
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4366
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4367 /* Value is a hash code for KEY for use in hash table H which uses as
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4368 user-defined function to compare keys. The hash code returned is
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4369 guaranteed to fit in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4370
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4371 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4372 hashfn_user_defined (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4373 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4374 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4375 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4376 Lisp_Object args[2], hash;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4377
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4378 args[0] = h->user_hash_function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4379 args[1] = key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4380 hash = Ffuncall (2, args);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4381 if (!INTEGERP (hash))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4382 Fsignal (Qerror,
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
4383 list2 (build_string ("Invalid hash code returned from \
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4384 user-supplied hash function"),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4385 hash));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4386 return XUINT (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4387 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4388
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4389
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4390 /* Create and initialize a new hash table.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4391
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4392 TEST specifies the test the hash table will use to compare keys.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4393 It must be either one of the predefined tests `eq', `eql' or
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4394 `equal' or a symbol denoting a user-defined test named TEST with
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4395 test and hash functions USER_TEST and USER_HASH.
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4396
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
4397 Give the table initial capacity SIZE, SIZE >= 0, an integer.
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4398
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4399 If REHASH_SIZE is an integer, it must be > 0, and this hash table's
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4400 new size when it becomes full is computed by adding REHASH_SIZE to
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4401 its old size. If REHASH_SIZE is a float, it must be > 1.0, and the
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4402 table's new size is computed by multiplying its old size with
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4403 REHASH_SIZE.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4404
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4405 REHASH_THRESHOLD must be a float <= 1.0, and > 0. The table will
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4406 be resized when the ratio of (number of entries in the table) /
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4407 (table size) is >= REHASH_THRESHOLD.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4408
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4409 WEAK specifies the weakness of the table. If non-nil, it must be
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4410 one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4411
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4412 Lisp_Object
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4413 make_hash_table (test, size, rehash_size, rehash_threshold, weak,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4414 user_test, user_hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4415 Lisp_Object test, size, rehash_size, rehash_threshold, weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4416 Lisp_Object user_test, user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4417 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4418 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4419 Lisp_Object table;
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
4420 int index_size, i, sz;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4421
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4422 /* Preconditions. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4423 xassert (SYMBOLP (test));
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
4424 xassert (INTEGERP (size) && XINT (size) >= 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4425 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4426 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4427 xassert (FLOATP (rehash_threshold)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4428 && XFLOATINT (rehash_threshold) > 0
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4429 && XFLOATINT (rehash_threshold) <= 1.0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4430
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
4431 if (XFASTINT (size) == 0)
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
4432 size = make_number (1);
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
4433
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
4434 /* Allocate a table and initialize it. */
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
4435 h = allocate_hash_table ();
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4436
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4437 /* Initialize hash table slots. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4438 sz = XFASTINT (size);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4439
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4440 h->test = test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4441 if (EQ (test, Qeql))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4442 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4443 h->cmpfn = cmpfn_eql;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4444 h->hashfn = hashfn_eql;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4445 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4446 else if (EQ (test, Qeq))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4447 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4448 h->cmpfn = NULL;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4449 h->hashfn = hashfn_eq;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4450 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4451 else if (EQ (test, Qequal))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4452 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4453 h->cmpfn = cmpfn_equal;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4454 h->hashfn = hashfn_equal;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4455 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4456 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4457 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4458 h->user_cmp_function = user_test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4459 h->user_hash_function = user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4460 h->cmpfn = cmpfn_user_defined;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4461 h->hashfn = hashfn_user_defined;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4462 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4463
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4464 h->weak = weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4465 h->rehash_threshold = rehash_threshold;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4466 h->rehash_size = rehash_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4467 h->count = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4468 h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4469 h->hash = Fmake_vector (size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4470 h->next = Fmake_vector (size, Qnil);
29809
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
4471 /* Cast to int here avoids losing with gcc 2.95 on Tru64/Alpha... */
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
4472 index_size = next_almost_prime ((int) (sz / XFLOATINT (rehash_threshold)));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4473 h->index = Fmake_vector (make_number (index_size), Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4474
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4475 /* Set up the free list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4476 for (i = 0; i < sz - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4477 HASH_NEXT (h, i) = make_number (i + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4478 h->next_free = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4479
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4480 XSET_HASH_TABLE (table, h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4481 xassert (HASH_TABLE_P (table));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4482 xassert (XHASH_TABLE (table) == h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4483
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4484 /* Maybe add this hash table to the list of all weak hash tables. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4485 if (NILP (h->weak))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4486 h->next_weak = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4487 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4488 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4489 h->next_weak = Vweak_hash_tables;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4490 Vweak_hash_tables = table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4491 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4492
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4493 return table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4494 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4495
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4496
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4497 /* Return a copy of hash table H1. Keys and values are not copied,
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4498 only the table itself is. */
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4499
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4500 Lisp_Object
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4501 copy_hash_table (h1)
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4502 struct Lisp_Hash_Table *h1;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4503 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4504 Lisp_Object table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4505 struct Lisp_Hash_Table *h2;
40769
fa1546836808 (copy_hash_table): Remove unused variable `v'.
Pavel Janík <Pavel@Janik.cz>
parents: 40734
diff changeset
4506 struct Lisp_Vector *next;
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
4507
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
4508 h2 = allocate_hash_table ();
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4509 next = h2->vec_next;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4510 bcopy (h1, h2, sizeof *h2);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4511 h2->vec_next = next;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4512 h2->key_and_value = Fcopy_sequence (h1->key_and_value);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4513 h2->hash = Fcopy_sequence (h1->hash);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4514 h2->next = Fcopy_sequence (h1->next);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4515 h2->index = Fcopy_sequence (h1->index);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4516 XSET_HASH_TABLE (table, h2);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4517
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4518 /* Maybe add this hash table to the list of all weak hash tables. */
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4519 if (!NILP (h2->weak))
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4520 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4521 h2->next_weak = Vweak_hash_tables;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4522 Vweak_hash_tables = table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4523 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4524
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4525 return table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4526 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4527
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4528
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4529 /* Resize hash table H if it's too full. If H cannot be resized
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4530 because it's already too large, throw an error. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4531
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4532 static INLINE void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4533 maybe_resize_hash_table (h)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4534 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4535 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4536 if (NILP (h->next_free))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4537 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4538 int old_size = HASH_TABLE_SIZE (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4539 int i, new_size, index_size;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4540
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4541 if (INTEGERP (h->rehash_size))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4542 new_size = old_size + XFASTINT (h->rehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4543 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4544 new_size = old_size * XFLOATINT (h->rehash_size);
27901
70c1647c2bfc (maybe_resize_hash_table): Handle case of new size
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4545 new_size = max (old_size + 1, new_size);
29809
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
4546 index_size = next_almost_prime ((int)
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
4547 (new_size
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
4548 / XFLOATINT (h->rehash_threshold)));
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4549 if (max (index_size, 2 * new_size) > MOST_POSITIVE_FIXNUM)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4550 error ("Hash table too large to resize");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4551
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4552 h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4553 h->next = larger_vector (h->next, new_size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4554 h->hash = larger_vector (h->hash, new_size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4555 h->index = Fmake_vector (make_number (index_size), Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4556
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4557 /* Update the free list. Do it so that new entries are added at
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4558 the end of the free list. This makes some operations like
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4559 maphash faster. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4560 for (i = old_size; i < new_size - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4561 HASH_NEXT (h, i) = make_number (i + 1);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4562
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4563 if (!NILP (h->next_free))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4564 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4565 Lisp_Object last, next;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4566
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4567 last = h->next_free;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4568 while (next = HASH_NEXT (h, XFASTINT (last)),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4569 !NILP (next))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4570 last = next;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4571
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4572 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4573 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4574 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4575 XSETFASTINT (h->next_free, old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4576
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4577 /* Rehash. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4578 for (i = 0; i < old_size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4579 if (!NILP (HASH_HASH (h, i)))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4580 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4581 unsigned hash_code = XUINT (HASH_HASH (h, i));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4582 int start_of_bucket = hash_code % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4583 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4584 HASH_INDEX (h, start_of_bucket) = make_number (i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4585 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4586 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4587 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4588
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4589
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4590 /* Lookup KEY in hash table H. If HASH is non-null, return in *HASH
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4591 the hash code of KEY. Value is the index of the entry in H
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4592 matching KEY, or -1 if not found. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4593
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4594 int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4595 hash_lookup (h, key, hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4596 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4597 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4598 unsigned *hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4599 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4600 unsigned hash_code;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4601 int start_of_bucket;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4602 Lisp_Object idx;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4603
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4604 hash_code = h->hashfn (h, key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4605 if (hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4606 *hash = hash_code;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4607
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4608 start_of_bucket = hash_code % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4609 idx = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4610
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
4611 /* We need not gcpro idx since it's either an integer or nil. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4612 while (!NILP (idx))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4613 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4614 int i = XFASTINT (idx);
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4615 if (EQ (key, HASH_KEY (h, i))
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4616 || (h->cmpfn
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4617 && h->cmpfn (h, key, hash_code,
28507
b6f06a755c7d make_number/XINT/XUINT conversions; EQ/== fixes; ==Qnil -> NILP
Ken Raeburn <raeburn@raeburn.org>
parents: 28493
diff changeset
4618 HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4619 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4620 idx = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4621 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4622
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4623 return NILP (idx) ? -1 : XFASTINT (idx);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4624 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4625
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4626
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4627 /* Put an entry into hash table H that associates KEY with VALUE.
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
4628 HASH is a previously computed hash code of KEY.
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
4629 Value is the index of the entry in H matching KEY. */
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
4630
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
4631 int
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4632 hash_put (h, key, value, hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4633 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4634 Lisp_Object key, value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4635 unsigned hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4636 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4637 int start_of_bucket, i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4638
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4639 xassert ((hash & ~INTMASK) == 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4640
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4641 /* Increment count after resizing because resizing may fail. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4642 maybe_resize_hash_table (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4643 h->count = make_number (XFASTINT (h->count) + 1);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4644
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4645 /* Store key/value in the key_and_value vector. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4646 i = XFASTINT (h->next_free);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4647 h->next_free = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4648 HASH_KEY (h, i) = key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4649 HASH_VALUE (h, i) = value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4650
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4651 /* Remember its hash code. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4652 HASH_HASH (h, i) = make_number (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4653
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4654 /* Add new entry to its collision chain. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4655 start_of_bucket = hash % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4656 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4657 HASH_INDEX (h, start_of_bucket) = make_number (i);
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
4658 return i;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4659 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4660
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4661
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4662 /* Remove the entry matching KEY from hash table H, if there is one. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4663
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4664 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4665 hash_remove (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4666 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4667 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4668 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4669 unsigned hash_code;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4670 int start_of_bucket;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4671 Lisp_Object idx, prev;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4672
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4673 hash_code = h->hashfn (h, key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4674 start_of_bucket = hash_code % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4675 idx = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4676 prev = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4677
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
4678 /* We need not gcpro idx, prev since they're either integers or nil. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4679 while (!NILP (idx))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4680 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4681 int i = XFASTINT (idx);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4682
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4683 if (EQ (key, HASH_KEY (h, i))
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4684 || (h->cmpfn
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
4685 && h->cmpfn (h, key, hash_code,
28507
b6f06a755c7d make_number/XINT/XUINT conversions; EQ/== fixes; ==Qnil -> NILP
Ken Raeburn <raeburn@raeburn.org>
parents: 28493
diff changeset
4686 HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4687 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4688 /* Take entry out of collision chain. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4689 if (NILP (prev))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4690 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4691 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4692 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4693
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4694 /* Clear slots in key_and_value and add the slots to
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4695 the free list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4696 HASH_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4697 HASH_NEXT (h, i) = h->next_free;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4698 h->next_free = make_number (i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4699 h->count = make_number (XFASTINT (h->count) - 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4700 xassert (XINT (h->count) >= 0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4701 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4702 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4703 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4704 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4705 prev = idx;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4706 idx = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4707 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4708 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4709 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4710
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4711
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4712 /* Clear hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4713
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4714 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4715 hash_clear (h)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4716 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4717 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4718 if (XFASTINT (h->count) > 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4719 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4720 int i, size = HASH_TABLE_SIZE (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4721
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4722 for (i = 0; i < size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4723 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4724 HASH_NEXT (h, i) = i < size - 1 ? make_number (i + 1) : Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4725 HASH_KEY (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4726 HASH_VALUE (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4727 HASH_HASH (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4728 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4729
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4730 for (i = 0; i < XVECTOR (h->index)->size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4731 XVECTOR (h->index)->contents[i] = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4732
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4733 h->next_free = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4734 h->count = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4735 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4736 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4737
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4738
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4739
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4740 /************************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4741 Weak Hash Tables
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4742 ************************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4743
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4744 /* Sweep weak hash table H. REMOVE_ENTRIES_P non-zero means remove
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4745 entries from the table that don't survive the current GC.
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4746 REMOVE_ENTRIES_P zero means mark entries that are in use. Value is
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4747 non-zero if anything was marked. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4748
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4749 static int
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4750 sweep_weak_table (h, remove_entries_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4751 struct Lisp_Hash_Table *h;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4752 int remove_entries_p;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4753 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4754 int bucket, n, marked;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4755
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4756 n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4757 marked = 0;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4758
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4759 for (bucket = 0; bucket < n; ++bucket)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4760 {
35513
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
4761 Lisp_Object idx, next, prev;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4762
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4763 /* Follow collision chain, removing entries that
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4764 don't survive this garbage collection. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4765 prev = Qnil;
35513
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
4766 for (idx = HASH_INDEX (h, bucket); !GC_NILP (idx); idx = next)
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4767 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4768 int i = XFASTINT (idx);
35513
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
4769 int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
4770 int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
4771 int remove_p;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4772
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4773 if (EQ (h->weak, Qkey))
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4774 remove_p = !key_known_to_survive_p;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4775 else if (EQ (h->weak, Qvalue))
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4776 remove_p = !value_known_to_survive_p;
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4777 else if (EQ (h->weak, Qkey_or_value))
30637
b54946f3cbbc (sweep_weak_table): Fix survival conditions for
Gerd Moellmann <gerd@gnu.org>
parents: 30634
diff changeset
4778 remove_p = !(key_known_to_survive_p || value_known_to_survive_p);
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4779 else if (EQ (h->weak, Qkey_and_value))
30637
b54946f3cbbc (sweep_weak_table): Fix survival conditions for
Gerd Moellmann <gerd@gnu.org>
parents: 30634
diff changeset
4780 remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4781 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4782 abort ();
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4783
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4784 next = HASH_NEXT (h, i);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4785
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4786 if (remove_entries_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4787 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4788 if (remove_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4789 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4790 /* Take out of collision chain. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4791 if (GC_NILP (prev))
35513
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
4792 HASH_INDEX (h, bucket) = next;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4793 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4794 HASH_NEXT (h, XFASTINT (prev)) = next;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4795
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4796 /* Add to free list. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4797 HASH_NEXT (h, i) = h->next_free;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4798 h->next_free = idx;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4799
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4800 /* Clear key, value, and hash. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4801 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4802 HASH_HASH (h, i) = Qnil;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4803
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4804 h->count = make_number (XFASTINT (h->count) - 1);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4805 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4806 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4807 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4808 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4809 if (!remove_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4810 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4811 /* Make sure key and value survive. */
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4812 if (!key_known_to_survive_p)
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4813 {
51768
31f2f6a2df06 (sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51397
diff changeset
4814 mark_object (HASH_KEY (h, i));
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4815 marked = 1;
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4816 }
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4817
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4818 if (!value_known_to_survive_p)
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4819 {
51768
31f2f6a2df06 (sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51397
diff changeset
4820 mark_object (HASH_VALUE (h, i));
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4821 marked = 1;
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4822 }
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4823 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4824 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4825 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4826 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4827
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4828 return marked;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4829 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4830
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4831 /* Remove elements from weak hash tables that don't survive the
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4832 current garbage collection. Remove weak tables that don't survive
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4833 from Vweak_hash_tables. Called from gc_sweep. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4834
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4835 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4836 sweep_weak_hash_tables ()
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4837 {
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4838 Lisp_Object table, used, next;
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4839 struct Lisp_Hash_Table *h;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4840 int marked;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4841
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4842 /* Mark all keys and values that are in use. Keep on marking until
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4843 there is no more change. This is necessary for cases like
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4844 value-weak table A containing an entry X -> Y, where Y is used in a
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4845 key-weak table B, Z -> Y. If B comes after A in the list of weak
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4846 tables, X -> Y might be removed from A, although when looking at B
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4847 one finds that it shouldn't. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4848 do
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4849 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4850 marked = 0;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4851 for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4852 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4853 h = XHASH_TABLE (table);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4854 if (h->size & ARRAY_MARK_FLAG)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4855 marked |= sweep_weak_table (h, 0);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4856 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4857 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4858 while (marked);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4859
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4860 /* Remove tables and entries that aren't used. */
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4861 for (table = Vweak_hash_tables, used = Qnil; !GC_NILP (table); table = next)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4862 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4863 h = XHASH_TABLE (table);
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4864 next = h->next_weak;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4865
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4866 if (h->size & ARRAY_MARK_FLAG)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4867 {
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4868 /* TABLE is marked as used. Sweep its contents. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4869 if (XFASTINT (h->count) > 0)
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4870 sweep_weak_table (h, 1);
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4871
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4872 /* Add table to the list of used weak hash tables. */
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4873 h->next_weak = used;
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4874 used = table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4875 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4876 }
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4877
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4878 Vweak_hash_tables = used;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4879 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4880
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4881
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4882
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4883 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4884 Hash Code Computation
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4885 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4886
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4887 /* Maximum depth up to which to dive into Lisp structures. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4888
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4889 #define SXHASH_MAX_DEPTH 3
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4890
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4891 /* Maximum length up to which to take list and vector elements into
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4892 account. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4893
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4894 #define SXHASH_MAX_LEN 7
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4895
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4896 /* Combine two integers X and Y for hashing. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4897
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4898 #define SXHASH_COMBINE(X, Y) \
25709
ba4e2a641663 (SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents: 25690
diff changeset
4899 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4900 + (unsigned)(Y))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4901
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4902
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4903 /* Return a hash for string PTR which has length LEN. The hash
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4904 code returned is guaranteed to fit in a Lisp integer. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4905
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4906 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4907 sxhash_string (ptr, len)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4908 unsigned char *ptr;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4909 int len;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4910 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4911 unsigned char *p = ptr;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4912 unsigned char *end = p + len;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4913 unsigned char c;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4914 unsigned hash = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4915
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4916 while (p != end)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4917 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4918 c = *p++;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4919 if (c >= 0140)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4920 c -= 40;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4921 hash = ((hash << 3) + (hash >> 28) + c);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4922 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4923
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4924 return hash & INTMASK;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4925 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4926
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4927
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4928 /* Return a hash for list LIST. DEPTH is the current depth in the
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4929 list. We don't recurse deeper than SXHASH_MAX_DEPTH in it. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4930
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4931 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4932 sxhash_list (list, depth)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4933 Lisp_Object list;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4934 int depth;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4935 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4936 unsigned hash = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4937 int i;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4938
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4939 if (depth < SXHASH_MAX_DEPTH)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4940 for (i = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4941 CONSP (list) && i < SXHASH_MAX_LEN;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4942 list = XCDR (list), ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4943 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4944 unsigned hash2 = sxhash (XCAR (list), depth + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4945 hash = SXHASH_COMBINE (hash, hash2);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4946 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4947
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4948 return hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4949 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4950
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4951
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4952 /* Return a hash for vector VECTOR. DEPTH is the current depth in
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4953 the Lisp structure. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4954
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4955 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4956 sxhash_vector (vec, depth)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4957 Lisp_Object vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4958 int depth;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4959 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4960 unsigned hash = XVECTOR (vec)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4961 int i, n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4962
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4963 n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4964 for (i = 0; i < n; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4965 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4966 unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4967 hash = SXHASH_COMBINE (hash, hash2);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4968 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4969
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4970 return hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4971 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4972
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4973
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4974 /* Return a hash for bool-vector VECTOR. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4975
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4976 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4977 sxhash_bool_vector (vec)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4978 Lisp_Object vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4979 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4980 unsigned hash = XBOOL_VECTOR (vec)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4981 int i, n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4982
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4983 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4984 for (i = 0; i < n; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4985 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4986
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4987 return hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4988 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4989
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4990
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4991 /* Return a hash code for OBJ. DEPTH is the current depth in the Lisp
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4992 structure. Value is an unsigned integer clipped to INTMASK. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4993
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4994 unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4995 sxhash (obj, depth)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4996 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4997 int depth;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4998 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4999 unsigned hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5000
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5001 if (depth > SXHASH_MAX_DEPTH)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5002 return 0;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5003
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5004 switch (XTYPE (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5005 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5006 case Lisp_Int:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5007 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5008 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5009
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5010 case Lisp_Symbol:
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
5011 hash = sxhash_string (SDATA (SYMBOL_NAME (obj)),
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
5012 SCHARS (SYMBOL_NAME (obj)));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5013 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5014
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5015 case Lisp_Misc:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5016 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5017 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5018
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5019 case Lisp_String:
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
5020 hash = sxhash_string (SDATA (obj), SCHARS (obj));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5021 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5022
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5023 /* This can be everything from a vector to an overlay. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5024 case Lisp_Vectorlike:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5025 if (VECTORP (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5026 /* According to the CL HyperSpec, two arrays are equal only if
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5027 they are `eq', except for strings and bit-vectors. In
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5028 Emacs, this works differently. We have to compare element
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5029 by element. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5030 hash = sxhash_vector (obj, depth);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5031 else if (BOOL_VECTOR_P (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5032 hash = sxhash_bool_vector (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5033 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5034 /* Others are `equal' if they are `eq', so let's take their
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5035 address as hash. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5036 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5037 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5038
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5039 case Lisp_Cons:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5040 hash = sxhash_list (obj, depth);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5041 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5042
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5043 case Lisp_Float:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5044 {
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
5045 unsigned char *p = (unsigned char *) &XFLOAT_DATA (obj);
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
5046 unsigned char *e = p + sizeof XFLOAT_DATA (obj);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5047 for (hash = 0; p < e; ++p)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5048 hash = SXHASH_COMBINE (hash, *p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5049 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5050 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5051
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5052 default:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5053 abort ();
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5054 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5055
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
5056 return hash & INTMASK;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5057 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5058
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5059
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5060
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5061 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5062 Lisp Interface
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5063 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5064
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5065
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5066 DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5067 doc: /* Compute a hash code for OBJ and return it as integer. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5068 (obj)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5069 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5070 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5071 unsigned hash = sxhash (obj, 0);;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5072 return make_number (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5073 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5074
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5075
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5076 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5077 doc: /* Create and return a new hash table.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5078
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5079 Arguments are specified as keyword/argument pairs. The following
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5080 arguments are defined:
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5081
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5082 :test TEST -- TEST must be a symbol that specifies how to compare
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5083 keys. Default is `eql'. Predefined are the tests `eq', `eql', and
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5084 `equal'. User-supplied test and hash functions can be specified via
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5085 `define-hash-table-test'.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5086
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5087 :size SIZE -- A hint as to how many elements will be put in the table.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5088 Default is 65.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5089
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5090 :rehash-size REHASH-SIZE - Indicates how to expand the table when it
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5091 fills up. If REHASH-SIZE is an integer, add that many space. If it
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5092 is a float, it must be > 1.0, and the new size is computed by
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5093 multiplying the old size with that factor. Default is 1.5.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5094
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5095 :rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5096 Resize the hash table when ratio of the number of entries in the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5097 table. Default is 0.8.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5098
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5099 :weakness WEAK -- WEAK must be one of nil, t, `key', `value',
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5100 `key-or-value', or `key-and-value'. If WEAK is not nil, the table
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5101 returned is a weak table. Key/value pairs are removed from a weak
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5102 hash table when there are no non-weak references pointing to their
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5103 key, value, one of key or value, or both key and value, depending on
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5104 WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
5105 is nil.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
5106
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
5107 usage: (make-hash-table &rest KEYWORD-ARGS) */)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5108 (nargs, args)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5109 int nargs;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5110 Lisp_Object *args;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5111 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5112 Lisp_Object test, size, rehash_size, rehash_threshold, weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5113 Lisp_Object user_test, user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5114 char *used;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5115 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5116
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5117 /* The vector `used' is used to keep track of arguments that
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5118 have been consumed. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5119 used = (char *) alloca (nargs * sizeof *used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5120 bzero (used, nargs * sizeof *used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5121
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5122 /* See if there's a `:test TEST' among the arguments. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5123 i = get_key_arg (QCtest, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5124 test = i < 0 ? Qeql : args[i];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5125 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5126 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5127 /* See if it is a user-defined test. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5128 Lisp_Object prop;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5129
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5130 prop = Fget (test, Qhash_table_test);
40734
95dd892ad5e3 (Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents: 40656
diff changeset
5131 if (!CONSP (prop) || !CONSP (XCDR (prop)))
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
5132 Fsignal (Qerror, list2 (build_string ("Invalid hash table test"),
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5133 test));
40734
95dd892ad5e3 (Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents: 40656
diff changeset
5134 user_test = XCAR (prop);
95dd892ad5e3 (Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents: 40656
diff changeset
5135 user_hash = XCAR (XCDR (prop));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5136 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5137 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5138 user_test = user_hash = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5139
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5140 /* See if there's a `:size SIZE' argument. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5141 i = get_key_arg (QCsize, nargs, args, used);
46221
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
5142 size = i < 0 ? Qnil : args[i];
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
5143 if (NILP (size))
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
5144 size = make_number (DEFAULT_HASH_SIZE);
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
5145 else if (!INTEGERP (size) || XINT (size) < 0)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5146 Fsignal (Qerror,
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
5147 list2 (build_string ("Invalid hash table size"),
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5148 size));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5149
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5150 /* Look for `:rehash-size SIZE'. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5151 i = get_key_arg (QCrehash_size, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5152 rehash_size = i < 0 ? make_float (DEFAULT_REHASH_SIZE) : args[i];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5153 if (!NUMBERP (rehash_size)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5154 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5155 || XFLOATINT (rehash_size) <= 1.0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5156 Fsignal (Qerror,
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
5157 list2 (build_string ("Invalid hash table rehash size"),
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5158 rehash_size));
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5159
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5160 /* Look for `:rehash-threshold THRESHOLD'. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5161 i = get_key_arg (QCrehash_threshold, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5162 rehash_threshold = i < 0 ? make_float (DEFAULT_REHASH_THRESHOLD) : args[i];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5163 if (!FLOATP (rehash_threshold)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5164 || XFLOATINT (rehash_threshold) <= 0.0
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5165 || XFLOATINT (rehash_threshold) > 1.0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5166 Fsignal (Qerror,
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
5167 list2 (build_string ("Invalid hash table rehash threshold"),
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5168 rehash_threshold));
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5169
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
5170 /* Look for `:weakness WEAK'. */
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
5171 i = get_key_arg (QCweakness, nargs, args, used);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5172 weak = i < 0 ? Qnil : args[i];
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5173 if (EQ (weak, Qt))
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5174 weak = Qkey_and_value;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5175 if (!NILP (weak)
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5176 && !EQ (weak, Qkey)
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5177 && !EQ (weak, Qvalue)
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5178 && !EQ (weak, Qkey_or_value)
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5179 && !EQ (weak, Qkey_and_value))
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
5180 Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"),
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5181 weak));
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5182
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5183 /* Now, all args should have been used up, or there's a problem. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5184 for (i = 0; i < nargs; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5185 if (!used[i])
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5186 Fsignal (Qerror,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5187 list2 (build_string ("Invalid argument list"), args[i]));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5188
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5189 return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5190 user_test, user_hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5191 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5192
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5193
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5194 DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5195 doc: /* Return a copy of hash table TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5196 (table)
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5197 Lisp_Object table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5198 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5199 return copy_hash_table (check_hash_table (table));
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5200 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5201
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5202
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5203 DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5204 doc: /* Return the number of elements in TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5205 (table)
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5206 Lisp_Object table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5207 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5208 return check_hash_table (table)->count;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5209 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5210
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5211
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5212 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5213 Shash_table_rehash_size, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5214 doc: /* Return the current rehash size of TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5215 (table)
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5216 Lisp_Object table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5217 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5218 return check_hash_table (table)->rehash_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5219 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5220
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5221
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5222 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5223 Shash_table_rehash_threshold, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5224 doc: /* Return the current rehash threshold of TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5225 (table)
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5226 Lisp_Object table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5227 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5228 return check_hash_table (table)->rehash_threshold;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5229 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5230
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5231
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5232 DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5233 doc: /* Return the size of TABLE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5234 The size can be used as an argument to `make-hash-table' to create
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5235 a hash table than can hold as many elements of TABLE holds
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5236 without need for resizing. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5237 (table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5238 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5239 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5240 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5241 return make_number (HASH_TABLE_SIZE (h));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5242 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5243
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5244
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5245 DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5246 doc: /* Return the test TABLE uses. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5247 (table)
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5248 Lisp_Object table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5249 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5250 return check_hash_table (table)->test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5251 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5252
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5253
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
5254 DEFUN ("hash-table-weakness", Fhash_table_weakness, Shash_table_weakness,
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
5255 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5256 doc: /* Return the weakness of TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5257 (table)
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5258 Lisp_Object table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5259 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5260 return check_hash_table (table)->weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5261 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5262
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5263
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5264 DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5265 doc: /* Return t if OBJ is a Lisp hash table object. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5266 (obj)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5267 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5268 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5269 return HASH_TABLE_P (obj) ? Qt : Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5270 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5271
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5272
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5273 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5274 doc: /* Clear hash table TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5275 (table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5276 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5277 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5278 hash_clear (check_hash_table (table));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5279 return Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5280 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5281
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5282
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5283 DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5284 doc: /* Look up KEY in TABLE and return its associated value.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5285 If KEY is not found, return DFLT which defaults to nil. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5286 (key, table, dflt)
26088
b7aa6ac26872 Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents: 25709
diff changeset
5287 Lisp_Object key, table, dflt;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5288 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5289 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5290 int i = hash_lookup (h, key, NULL);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5291 return i >= 0 ? HASH_VALUE (h, i) : dflt;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5292 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5293
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5294
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5295 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5296 doc: /* Associate KEY with VALUE in hash table TABLE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5297 If KEY is already present in table, replace its current value with
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5298 VALUE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5299 (key, value, table)
25080
46c21258f1ff (Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents: 25071
diff changeset
5300 Lisp_Object key, value, table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5301 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5302 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5303 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5304 unsigned hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5305
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5306 i = hash_lookup (h, key, &hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5307 if (i >= 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5308 HASH_VALUE (h, i) = value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5309 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5310 hash_put (h, key, value, hash);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5311
29991
fff5fd809d11 (Fputhash): Return `value' rather than nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29979
diff changeset
5312 return value;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5313 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5314
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5315
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5316 DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5317 doc: /* Remove KEY from TABLE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5318 (key, table)
25080
46c21258f1ff (Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents: 25071
diff changeset
5319 Lisp_Object key, table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5320 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5321 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5322 hash_remove (h, key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5323 return Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5324 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5325
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5326
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5327 DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5328 doc: /* Call FUNCTION for all entries in hash table TABLE.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5329 FUNCTION is called with 2 arguments KEY and VALUE. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5330 (function, table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5331 Lisp_Object function, table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5332 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5333 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5334 Lisp_Object args[3];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5335 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5336
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5337 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5338 if (!NILP (HASH_HASH (h, i)))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5339 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5340 args[0] = function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5341 args[1] = HASH_KEY (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5342 args[2] = HASH_VALUE (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5343 Ffuncall (3, args);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5344 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5345
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5346 return Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5347 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5348
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5349
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5350 DEFUN ("define-hash-table-test", Fdefine_hash_table_test,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5351 Sdefine_hash_table_test, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5352 doc: /* Define a new hash table test with name NAME, a symbol.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5353
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5354 In hash tables created with NAME specified as test, use TEST to
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5355 compare keys, and HASH for computing hash codes of keys.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5356
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5357 TEST must be a function taking two arguments and returning non-nil if
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5358 both arguments are the same. HASH must be a function taking one
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5359 argument and return an integer that is the hash code of the argument.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5360 Hash code computation should use the whole value range of integers,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5361 including negative integers. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5362 (name, test, hash)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5363 Lisp_Object name, test, hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5364 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5365 return Fput (name, Qhash_table_test, list2 (test, hash));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5366 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5367
28965
dead0196fbc8 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 28962
diff changeset
5368
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5369
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5370 /************************************************************************
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5371 MD5
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5372 ************************************************************************/
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5373
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5374 #include "md5.h"
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5375 #include "coding.h"
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5376
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5377 DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5378 doc: /* Return MD5 message digest of OBJECT, a buffer or string.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5379
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5380 A message digest is a cryptographic checksum of a document, and the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5381 algorithm to calculate it is defined in RFC 1321.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5382
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5383 The two optional arguments START and END are character positions
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5384 specifying for which part of OBJECT the message digest should be
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5385 computed. If nil or omitted, the digest is computed for the whole
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5386 OBJECT.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5387
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5388 The MD5 message digest is computed from the result of encoding the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5389 text in a coding system, not directly from the internal Emacs form of
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5390 the text. The optional fourth argument CODING-SYSTEM specifies which
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5391 coding system to encode the text with. It should be the same coding
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5392 system that you used or will use when actually writing the text into a
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5393 file.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5394
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5395 If CODING-SYSTEM is nil or omitted, the default depends on OBJECT. If
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5396 OBJECT is a buffer, the default for CODING-SYSTEM is whatever coding
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5397 system would be chosen by default for writing this text into a file.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5398
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5399 If OBJECT is a string, the most preferred coding system (see the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5400 command `prefer-coding-system') is used.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5401
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5402 If NOERROR is non-nil, silently assume the `raw-text' coding if the
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5403 guesswork fails. Normally, an error is signaled in such case. */)
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5404 (object, start, end, coding_system, noerror)
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5405 Lisp_Object object, start, end, coding_system, noerror;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5406 {
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5407 unsigned char digest[16];
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5408 unsigned char value[33];
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5409 int i;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5410 int size;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5411 int size_byte = 0;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5412 int start_char = 0, end_char = 0;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5413 int start_byte = 0, end_byte = 0;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5414 register int b, e;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5415 register struct buffer *bp;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5416 int temp;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5417
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5418 if (STRINGP (object))
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5419 {
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5420 if (NILP (coding_system))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5421 {
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5422 /* Decide the coding-system to encode the data with. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5423
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5424 if (STRING_MULTIBYTE (object))
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5425 /* use default, we can't guess correct value */
39581
6d9fa06012a6 Use SYMBOL_VALUE/SET_SYMBOL_VALUE macros instead of accessing
Gerd Moellmann <gerd@gnu.org>
parents: 39072
diff changeset
5426 coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list));
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5427 else
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5428 coding_system = Qraw_text;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5429 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5430
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5431 if (NILP (Fcoding_system_p (coding_system)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5432 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5433 /* Invalid coding system. */
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5434
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5435 if (!NILP (noerror))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5436 coding_system = Qraw_text;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5437 else
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5438 while (1)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5439 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5440 }
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5441
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5442 if (STRING_MULTIBYTE (object))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5443 object = code_convert_string1 (object, coding_system, Qnil, 1);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5444
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
5445 size = SCHARS (object);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
5446 size_byte = SBYTES (object);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5447
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5448 if (!NILP (start))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5449 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
5450 CHECK_NUMBER (start);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5451
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5452 start_char = XINT (start);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5453
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5454 if (start_char < 0)
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5455 start_char += size;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5456
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5457 start_byte = string_char_to_byte (object, start_char);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5458 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5459
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5460 if (NILP (end))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5461 {
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5462 end_char = size;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5463 end_byte = size_byte;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5464 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5465 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5466 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
5467 CHECK_NUMBER (end);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5468
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5469 end_char = XINT (end);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5470
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5471 if (end_char < 0)
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5472 end_char += size;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5473
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5474 end_byte = string_char_to_byte (object, end_char);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5475 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5476
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5477 if (!(0 <= start_char && start_char <= end_char && end_char <= size))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5478 args_out_of_range_3 (object, make_number (start_char),
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5479 make_number (end_char));
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5480 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5481 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5482 {
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5483 struct buffer *prev = current_buffer;
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5484
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5485 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5486
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
5487 CHECK_BUFFER (object);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5488
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5489 bp = XBUFFER (object);
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5490 if (bp != current_buffer)
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5491 set_buffer_internal (bp);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5492
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5493 if (NILP (start))
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5494 b = BEGV;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5495 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5496 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
5497 CHECK_NUMBER_COERCE_MARKER (start);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5498 b = XINT (start);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5499 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5500
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5501 if (NILP (end))
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5502 e = ZV;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5503 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5504 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
5505 CHECK_NUMBER_COERCE_MARKER (end);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5506 e = XINT (end);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5507 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5508
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5509 if (b > e)
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5510 temp = b, b = e, e = temp;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5511
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5512 if (!(BEGV <= b && e <= ZV))
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5513 args_out_of_range (start, end);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5514
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5515 if (NILP (coding_system))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5516 {
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5517 /* Decide the coding-system to encode the data with.
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5518 See fileio.c:Fwrite-region */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5519
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5520 if (!NILP (Vcoding_system_for_write))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5521 coding_system = Vcoding_system_for_write;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5522 else
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5523 {
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5524 int force_raw_text = 0;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5525
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5526 coding_system = XBUFFER (object)->buffer_file_coding_system;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5527 if (NILP (coding_system)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5528 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5529 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5530 coding_system = Qnil;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5531 if (NILP (current_buffer->enable_multibyte_characters))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5532 force_raw_text = 1;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5533 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5534
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5535 if (NILP (coding_system) && !NILP (Fbuffer_file_name(object)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5536 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5537 /* Check file-coding-system-alist. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5538 Lisp_Object args[4], val;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5539
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5540 args[0] = Qwrite_region; args[1] = start; args[2] = end;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5541 args[3] = Fbuffer_file_name(object);
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5542 val = Ffind_operation_coding_system (4, args);
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5543 if (CONSP (val) && !NILP (XCDR (val)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5544 coding_system = XCDR (val);
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5545 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5546
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5547 if (NILP (coding_system)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5548 && !NILP (XBUFFER (object)->buffer_file_coding_system))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5549 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5550 /* If we still have not decided a coding system, use the
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5551 default value of buffer-file-coding-system. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5552 coding_system = XBUFFER (object)->buffer_file_coding_system;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5553 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5554
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5555 if (!force_raw_text
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5556 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5557 /* Confirm that VAL can surely encode the current region. */
45629
6adda7388fcc (md5): Pass FILE arg to Vselect_safe_coding_system_function.
Richard M. Stallman <rms@gnu.org>
parents: 45401
diff changeset
5558 coding_system = call4 (Vselect_safe_coding_system_function,
34153
f493b32a1a91 (Fmd5): Pass lisp objects, not integers, to call3.
Ken Raeburn <raeburn@raeburn.org>
parents: 34106
diff changeset
5559 make_number (b), make_number (e),
45629
6adda7388fcc (md5): Pass FILE arg to Vselect_safe_coding_system_function.
Richard M. Stallman <rms@gnu.org>
parents: 45401
diff changeset
5560 coding_system, Qnil);
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5561
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5562 if (force_raw_text)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5563 coding_system = Qraw_text;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5564 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5565
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5566 if (NILP (Fcoding_system_p (coding_system)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5567 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5568 /* Invalid coding system. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5569
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5570 if (!NILP (noerror))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5571 coding_system = Qraw_text;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5572 else
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5573 while (1)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5574 Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5575 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5576 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5577
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5578 object = make_buffer_string (b, e, 0);
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5579 if (prev != current_buffer)
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5580 set_buffer_internal (prev);
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5581 /* Discard the unwind protect for recovering the current
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5582 buffer. */
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
5583 specpdl_ptr--;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5584
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5585 if (STRING_MULTIBYTE (object))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5586 object = code_convert_string1 (object, coding_system, Qnil, 1);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5587 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5588
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5589 md5_buffer (SDATA (object) + start_byte,
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
5590 SBYTES (object) - (size_byte - end_byte),
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5591 digest);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5592
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5593 for (i = 0; i < 16; i++)
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
5594 sprintf (&value[2 * i], "%02x", digest[i]);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5595 value[32] = '\0';
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5596
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5597 return make_string (value, 32);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5598 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5599
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
5600
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
5601 void
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5602 syms_of_fns ()
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5603 {
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5604 /* Hash table stuff. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5605 Qhash_table_p = intern ("hash-table-p");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5606 staticpro (&Qhash_table_p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5607 Qeq = intern ("eq");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5608 staticpro (&Qeq);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5609 Qeql = intern ("eql");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5610 staticpro (&Qeql);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5611 Qequal = intern ("equal");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5612 staticpro (&Qequal);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5613 QCtest = intern (":test");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5614 staticpro (&QCtest);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5615 QCsize = intern (":size");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5616 staticpro (&QCsize);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5617 QCrehash_size = intern (":rehash-size");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5618 staticpro (&QCrehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5619 QCrehash_threshold = intern (":rehash-threshold");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5620 staticpro (&QCrehash_threshold);
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
5621 QCweakness = intern (":weakness");
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
5622 staticpro (&QCweakness);
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5623 Qkey = intern ("key");
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5624 staticpro (&Qkey);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5625 Qvalue = intern ("value");
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5626 staticpro (&Qvalue);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5627 Qhash_table_test = intern ("hash-table-test");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5628 staticpro (&Qhash_table_test);
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5629 Qkey_or_value = intern ("key-or-value");
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5630 staticpro (&Qkey_or_value);
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5631 Qkey_and_value = intern ("key-and-value");
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
5632 staticpro (&Qkey_and_value);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5633
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5634 defsubr (&Ssxhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5635 defsubr (&Smake_hash_table);
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
5636 defsubr (&Scopy_hash_table);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5637 defsubr (&Shash_table_count);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5638 defsubr (&Shash_table_rehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5639 defsubr (&Shash_table_rehash_threshold);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5640 defsubr (&Shash_table_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5641 defsubr (&Shash_table_test);
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
5642 defsubr (&Shash_table_weakness);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5643 defsubr (&Shash_table_p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5644 defsubr (&Sclrhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5645 defsubr (&Sgethash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5646 defsubr (&Sputhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5647 defsubr (&Sremhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5648 defsubr (&Smaphash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5649 defsubr (&Sdefine_hash_table_test);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
5650
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5651 Qstring_lessp = intern ("string-lessp");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5652 staticpro (&Qstring_lessp);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
5653 Qprovide = intern ("provide");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
5654 staticpro (&Qprovide);
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
5655 Qrequire = intern ("require");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
5656 staticpro (&Qrequire);
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
5657 Qyes_or_no_p_history = intern ("yes-or-no-p-history");
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
5658 staticpro (&Qyes_or_no_p_history);
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
5659 Qcursor_in_echo_area = intern ("cursor-in-echo-area");
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
5660 staticpro (&Qcursor_in_echo_area);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
5661 Qwidget_type = intern ("widget-type");
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
5662 staticpro (&Qwidget_type);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5663
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
5664 staticpro (&string_char_byte_cache_string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
5665 string_char_byte_cache_string = Qnil;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
5666
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
5667 require_nesting_list = Qnil;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
5668 staticpro (&require_nesting_list);
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
5669
14486
3c4ba112108e (syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents: 14456
diff changeset
5670 Fset (Qyes_or_no_p_history, Qnil);
3c4ba112108e (syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents: 14456
diff changeset
5671
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5672 DEFVAR_LISP ("features", &Vfeatures,
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5673 doc: /* A list of symbols which are the features of the executing emacs.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5674 Used by `featurep' and `require', and altered by `provide'. */);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5675 Vfeatures = Qnil;
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
5676 Qsubfeatures = intern ("subfeatures");
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
5677 staticpro (&Qsubfeatures);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5678
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5679 #ifdef HAVE_LANGINFO_CODESET
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5680 Qcodeset = intern ("codeset");
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5681 staticpro (&Qcodeset);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5682 Qdays = intern ("days");
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5683 staticpro (&Qdays);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5684 Qmonths = intern ("months");
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5685 staticpro (&Qmonths);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5686 Qpaper = intern ("paper");
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5687 staticpro (&Qpaper);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5688 #endif /* HAVE_LANGINFO_CODESET */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
5689
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5690 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5691 doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
44712
093bf061ef1d (use-dialog-box): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 44524
diff changeset
5692 This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
5693 invoked by mouse clicks and mouse menu items. */);
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
5694 use_dialog_box = 1;
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
5695
53189
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
5696 DEFVAR_BOOL ("use-file-dialog", &use_file_dialog,
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
5697 doc: /* *Non-nil means mouse commands use a file dialog to ask for files.
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
5698 This applies to commands from menus and tool bar buttons. The value of
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
5699 `use-dialog-box' takes precedence over this variable, so a file dialog is only
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
5700 used if both `use-dialog-box' and this variable are non-nil. */);
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
5701 use_file_dialog = 1;
53255
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
5702
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5703 defsubr (&Sidentity);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5704 defsubr (&Srandom);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5705 defsubr (&Slength);
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
5706 defsubr (&Ssafe_length);
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
5707 defsubr (&Sstring_bytes);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5708 defsubr (&Sstring_equal);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
5709 defsubr (&Scompare_strings);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5710 defsubr (&Sstring_lessp);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5711 defsubr (&Sappend);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5712 defsubr (&Sconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5713 defsubr (&Svconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5714 defsubr (&Scopy_sequence);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
5715 defsubr (&Sstring_make_multibyte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
5716 defsubr (&Sstring_make_unibyte);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
5717 defsubr (&Sstring_as_multibyte);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
5718 defsubr (&Sstring_as_unibyte);
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
5719 defsubr (&Sstring_to_multibyte);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5720 defsubr (&Scopy_alist);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5721 defsubr (&Ssubstring);
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
5722 defsubr (&Ssubstring_no_properties);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5723 defsubr (&Snthcdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5724 defsubr (&Snth);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5725 defsubr (&Selt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5726 defsubr (&Smember);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5727 defsubr (&Smemq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5728 defsubr (&Sassq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5729 defsubr (&Sassoc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5730 defsubr (&Srassq);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
5731 defsubr (&Srassoc);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5732 defsubr (&Sdelq);
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
5733 defsubr (&Sdelete);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5734 defsubr (&Snreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5735 defsubr (&Sreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5736 defsubr (&Ssort);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
5737 defsubr (&Splist_get);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5738 defsubr (&Sget);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
5739 defsubr (&Splist_put);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5740 defsubr (&Sput);
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
5741 defsubr (&Slax_plist_get);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
5742 defsubr (&Slax_plist_put);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5743 defsubr (&Sequal);
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
5744 defsubr (&Sequal_including_properties);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5745 defsubr (&Sfillarray);
52075
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
5746 defsubr (&Sclear_string);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
5747 defsubr (&Schar_table_subtype);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
5748 defsubr (&Schar_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
5749 defsubr (&Sset_char_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
5750 defsubr (&Schar_table_extra_slot);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
5751 defsubr (&Sset_char_table_extra_slot);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
5752 defsubr (&Schar_table_range);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
5753 defsubr (&Sset_char_table_range);
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
5754 defsubr (&Sset_char_table_default);
28222
33f6a8ee4733 (optimize_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 28072
diff changeset
5755 defsubr (&Soptimize_char_table);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
5756 defsubr (&Smap_char_table);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5757 defsubr (&Snconc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5758 defsubr (&Smapcar);
28666
3408e0502727 (syms_of_fns): Defsubr mapc.
Dave Love <fx@gnu.org>
parents: 28555
diff changeset
5759 defsubr (&Smapc);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5760 defsubr (&Smapconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5761 defsubr (&Sy_or_n_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5762 defsubr (&Syes_or_no_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5763 defsubr (&Sload_average);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5764 defsubr (&Sfeaturep);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5765 defsubr (&Srequire);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5766 defsubr (&Sprovide);
29953
dad7b11391a3 (Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29809
diff changeset
5767 defsubr (&Splist_member);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
5768 defsubr (&Swidget_put);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
5769 defsubr (&Swidget_get);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
5770 defsubr (&Swidget_apply);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
5771 defsubr (&Sbase64_encode_region);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
5772 defsubr (&Sbase64_decode_region);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
5773 defsubr (&Sbase64_encode_string);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
5774 defsubr (&Sbase64_decode_string);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
5775 defsubr (&Smd5);
51976
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
5776 defsubr (&Slocale_info);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5777 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5778
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5779
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5780 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5781 init_fns ()
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5782 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5783 Vweak_hash_tables = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
5784 }
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52075
diff changeset
5785
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52075
diff changeset
5786 /* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52075
diff changeset
5787 (do not change this comment) */