annotate src/fns.c @ 27796:1cd9f06b5f21

*** empty log message ***
author Dave Love <fx@gnu.org>
date Mon, 21 Feb 2000 13:50:14 +0000
parents 9400865ec7cf
children 70c1647c2bfc
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.
24280
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 1999 Free Software Foundation, Inc.
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 This file is part of GNU Emacs.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 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
8 the Free Software Foundation; either version 2, or (at your option)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 any later version.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU General Public License for more details.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 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
18 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
19 Boston, MA 02111-1307, USA. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
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
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 /* Note on some machines this defines `vector' as a typedef,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 so make sure we don't use that name in this file. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 #undef vector
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
32 #define vector *****
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 #include "lisp.h"
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35 #include "commands.h"
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
36 #include "charset.h"
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38 #include "buffer.h"
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
39 #include "keyboard.h"
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
40 #include "intervals.h"
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
41 #include "frame.h"
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
42 #include "window.h"
21810
15f5abff4d9b [HAVE_MENUS]: Include xterm.h only if HAVE_X_WINDOWS.
Richard M. Stallman <rms@gnu.org>
parents: 21791
diff changeset
43 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS)
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
44 #include "xterm.h"
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
45 #endif
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46
12062
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
47 #ifndef NULL
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
48 #define NULL (void *)0
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
49 #endif
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
50
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
51 #ifndef min
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
52 #define min(a, b) ((a) < (b) ? (a) : (b))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
53 #define max(a, b) ((a) > (b) ? (a) : (b))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
54 #endif
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
55
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
56 /* Nonzero enables use of dialog boxes for questions
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
57 asked by mouse commands. */
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
58 int use_dialog_box;
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
59
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
60 extern int minibuffer_auto_raise;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
61 extern Lisp_Object minibuf_window;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
62
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
63 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
64 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
65 Lisp_Object Qcursor_in_echo_area;
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
66 Lisp_Object Qwidget_type;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67
23051
18ed8d6b11e5 (Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents: 22853
diff changeset
68 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
69
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
70 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
71
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
72 extern long get_random ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
73 extern void seed_random ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
74
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
75 #ifndef HAVE_UNISTD_H
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
76 extern long time ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
77 #endif
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
78
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
79 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
80 "Return the argument unchanged.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84 return arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88 "Return a pseudo-random number.\n\
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
89 All integers representable in Lisp are equally likely.\n\
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
90 On most systems, this is 28 bits' worth.\n\
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
91 With positive integer argument N, return random number in interval [0,N).\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 With argument t, set the random number seed from the current time and pid.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
93 (n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
94 Lisp_Object n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 {
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
96 EMACS_INT val;
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
97 Lisp_Object lispy_val;
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
98 unsigned long denominator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
100 if (EQ (n, Qt))
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
101 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
102 if (NATNUMP (n) && XFASTINT (n) != 0)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 {
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
104 /* 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
105 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
106 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
107 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
108 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
109 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
110 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
111 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
112 do
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
113 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
114 while (val >= XFASTINT (n));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 }
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
116 else
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
117 val = get_random ();
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
118 XSETINT (lispy_val, val);
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
119 return lispy_val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 /* Random data-structure functions */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 DEFUN ("length", Flength, Slength, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125 "Return the length of vector, list or string SEQUENCE.\n\
19383
ca0fca5eb8c9 (Flength): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 19278
diff changeset
126 A byte-code function object is also allowed.\n\
ca0fca5eb8c9 (Flength): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 19278
diff changeset
127 If the string contains multibyte characters, this is not the necessarily\n\
21383
aa16b532cf4c (Flength): Doc fix.
Andreas Schwab <schwab@suse.de>
parents: 21374
diff changeset
128 the number of bytes in the string; it is the number of characters.\n\
aa16b532cf4c (Flength): Doc fix.
Andreas Schwab <schwab@suse.de>
parents: 21374
diff changeset
129 To get the number of bytes, use `string-bytes'")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
130 (sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
131 register Lisp_Object sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
133 register Lisp_Object tail, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
134 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 retry:
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
137 if (STRINGP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
138 XSETFASTINT (val, XSTRING (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
139 else if (VECTORP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
140 XSETFASTINT (val, XVECTOR (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
141 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
142 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
143 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
144 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
145 else if (COMPILEDP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
146 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
147 else if (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 {
26256
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
149 i = 0;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
150 while (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
152 sequence = XCDR (sequence);
26256
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
153 ++i;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
154
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
155 if (!CONSP (sequence))
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
156 break;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
157
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
158 sequence = XCDR (sequence);
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
159 ++i;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
160 QUIT;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
163 if (!NILP (sequence))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
164 wrong_type_argument (Qlistp, sequence);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
165
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
166 val = make_number (i);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167 }
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
168 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
169 XSETFASTINT (val, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
172 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 }
9965
f68eab303ddb (Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents: 9927
diff changeset
175 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
178 /* This does not check for quits. That is safe
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
179 since it must terminate. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
180
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
181 DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
182 "Return the length of a list, but avoid error or infinite loop.\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
183 This function never gets an error. If LIST is not really a list,\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
184 it returns 0. If LIST is circular, it returns a finite value\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
185 which is at least the number of distinct elements.")
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
186 (list)
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
187 Lisp_Object list;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
188 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
189 Lisp_Object tail, halftail, length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
190 int len = 0;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
191
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
192 /* halftail is used to detect circular lists. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
193 halftail = list;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
194 for (tail = list; CONSP (tail); tail = XCDR (tail))
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
195 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
196 if (EQ (tail, halftail) && len != 0)
12618
60c4c0fee545 (Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents: 12466
diff changeset
197 break;
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
198 len++;
13344
30e17254a280 (Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents: 13277
diff changeset
199 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
200 halftail = XCDR (halftail);
12466
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
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
203 XSETINT (length, len);
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
204 return length;
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
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
207 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
208 "Return the number of bytes in STRING.\n\
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
209 If STRING is a multibyte string, this is greater than the length of STRING.")
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
210 (string)
20881
fd35cf0efd94 (Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents: 20880
diff changeset
211 Lisp_Object string;
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
212 {
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
213 CHECK_STRING (string, 1);
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
214 return make_number (STRING_BYTES (XSTRING (string)));
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
215 }
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
216
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
218 "Return t if two strings have identical contents.\n\
10114
6f6db8f5b8a0 (internal_equal): Call compare_string_intervals.
Richard M. Stallman <rms@gnu.org>
parents: 10059
diff changeset
219 Case is significant, but text properties are ignored.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
224 if (SYMBOLP (s1))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
225 XSETSTRING (s1, XSYMBOL (s1)->name);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
226 if (SYMBOLP (s2))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
227 XSETSTRING (s2, XSYMBOL (s2)->name);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
230
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
231 if (XSTRING (s1)->size != XSTRING (s2)->size
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
232 || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2))
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
233 || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1))))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
235 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
238 DEFUN ("compare-strings", Fcompare_strings,
21673
8a32bf93da04 (Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents: 21671
diff changeset
239 Scompare_strings, 6, 7, 0,
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
240 "Compare the contents of two strings, converting to multibyte if needed.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
241 In string STR1, skip the first START1 characters and stop at END1.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
242 In string STR2, skip the first START2 characters and stop at END2.\n\
21789
c7b93fe649d4 (Fcompare_strings): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21716
diff changeset
243 END1 and END2 default to the full lengths of the respective strings.\n\
c7b93fe649d4 (Fcompare_strings): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21716
diff changeset
244 \n\
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
245 Case is significant in this comparison if IGNORE-CASE is nil.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
246 Unibyte strings are converted to multibyte for comparison.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
247 \n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
248 The value is t if the strings (or specified portions) match.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
249 If string STR1 is less, the value is a negative number N;\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
250 - 1 - N is the number of characters that match at the beginning.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
251 If string STR1 is greater, the value is a positive number N;\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
252 N - 1 is the number of characters that match at the beginning.")
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
253 (str1, start1, end1, str2, start2, end2, ignore_case)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
254 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
255 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
256 register int end1_char, end2_char;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
257 register int i1, i1_byte, i2, i2_byte;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
258
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
259 CHECK_STRING (str1, 0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
260 CHECK_STRING (str2, 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
261 if (NILP (start1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
262 start1 = make_number (0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
263 if (NILP (start2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
264 start2 = make_number (0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
265 CHECK_NATNUM (start1, 2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
266 CHECK_NATNUM (start2, 3);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
267 if (! NILP (end1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
268 CHECK_NATNUM (end1, 4);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
269 if (! NILP (end2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
270 CHECK_NATNUM (end2, 4);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
271
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
272 i1 = XINT (start1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
273 i2 = XINT (start2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
274
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
275 i1_byte = string_char_to_byte (str1, i1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
276 i2_byte = string_char_to_byte (str2, i2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
277
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
278 end1_char = XSTRING (str1)->size;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
279 if (! NILP (end1) && end1_char > XINT (end1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
280 end1_char = XINT (end1);
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 end2_char = XSTRING (str2)->size;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
283 if (! NILP (end2) && end2_char > XINT (end2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
284 end2_char = XINT (end2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
285
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
286 while (i1 < end1_char && i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
287 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
288 /* When we find a mismatch, we must compare the
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
289 characters, not just the bytes. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
290 int c1, c2;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
291
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
292 if (STRING_MULTIBYTE (str1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
293 FETCH_STRING_CHAR_ADVANCE (c1, str1, i1, i1_byte);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
294 else
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 c1 = XSTRING (str1)->data[i1++];
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
297 c1 = unibyte_char_to_multibyte (c1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
298 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
299
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
300 if (STRING_MULTIBYTE (str2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
301 FETCH_STRING_CHAR_ADVANCE (c2, str2, i2, i2_byte);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
302 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
303 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
304 c2 = XSTRING (str2)->data[i2++];
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
305 c2 = unibyte_char_to_multibyte (c2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
306 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
307
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
308 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
309 continue;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
310
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
311 if (! NILP (ignore_case))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
312 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
313 Lisp_Object tem;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
314
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
315 tem = Fupcase (make_number (c1));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
316 c1 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
317 tem = Fupcase (make_number (c2));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
318 c2 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
319 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
320
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
321 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
322 continue;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
323
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
324 /* Note that I1 has already been incremented
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
325 past the character that we are comparing;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
326 hence we don't add or subtract 1 here. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
327 if (c1 < c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
328 return make_number (- i1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
329 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
330 return make_number (i1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
331 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
332
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
333 if (i1 < end1_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
334 return make_number (i1 - XINT (start1) + 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
335 if (i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
336 return make_number (- i1 + XINT (start1) - 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
337
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
338 return Qt;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
339 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
340
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
341 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
342 "Return t if first arg string is less than second in lexicographic order.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
343 Case is significant.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
344 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
345 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
346 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
347 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
348 register int end;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
349 register int i1, i1_byte, i2, i2_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
350
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
351 if (SYMBOLP (s1))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
352 XSETSTRING (s1, XSYMBOL (s1)->name);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
353 if (SYMBOLP (s2))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
354 XSETSTRING (s2, XSYMBOL (s2)->name);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
356 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
358 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
359
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
360 end = XSTRING (s1)->size;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
361 if (end > XSTRING (s2)->size)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
362 end = XSTRING (s2)->size;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
363
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
364 while (i1 < end)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
365 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
366 /* 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
367 characters, not just the bytes. */
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
368 int c1, c2;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
369
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
370 if (STRING_MULTIBYTE (s1))
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
371 FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
372 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
373 c1 = XSTRING (s1)->data[i1++];
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
374
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
375 if (STRING_MULTIBYTE (s2))
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
376 FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
377 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
378 c2 = XSTRING (s2)->data[i2++];
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
379
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
380 if (c1 != c2)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
381 return c1 < c2 ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
383 return i1 < XSTRING (s2)->size ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 static Lisp_Object concat ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390 concat2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
394 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
395 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
396 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 return concat (2, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 return concat (2, &s1, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
402
8966
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
403 /* ARGSUSED */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
404 Lisp_Object
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
405 concat3 (s1, s2, s3)
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
406 Lisp_Object s1, s2, s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
407 {
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
408 #ifdef NO_ARG_ARRAY
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
409 Lisp_Object args[3];
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
410 args[0] = s1;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
411 args[1] = s2;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
412 args[2] = s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
413 return concat (3, args, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
414 #else
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
415 return concat (3, &s1, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
416 #endif /* NO_ARG_ARRAY */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
417 }
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
418
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 "Concatenate all the arguments and make the result a list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421 The result is a list whose elements are the elements of all the arguments.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 Each argument may be a list, vector or string.\n\
1037
c17a6750293c (Fappend): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 866
diff changeset
423 The last argument is not copied, just used as the tail of the new list.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
425 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 return concat (nargs, args, Lisp_Cons, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432 "Concatenate all the arguments and make the result a string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433 The result is a string whose elements are the elements of all the arguments.\n\
11142
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
434 Each argument may be a string or a list or vector of characters (integers).\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
435 \n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
436 Do not use individual integers as arguments!\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
437 The behavior of `concat' in that case will be changed later!\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
438 If your program passes an integer as an argument to `concat',\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
439 you should change it right away not to do so.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 (nargs, args)
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,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
448 "Concatenate all the arguments and make the result a vector.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
449 The result is a vector whose elements are the elements of all the arguments.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
450 Each argument may be a list, vector or string.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
452 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454 {
10006
402c87cbc4fa (Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9965
diff changeset
455 return concat (nargs, args, Lisp_Vectorlike, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
458 /* Retrun a copy of a sub char table ARG. The elements except for a
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
459 nested sub char table are not copied. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
460 static Lisp_Object
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
461 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
462 Lisp_Object arg;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
463 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
464 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
465 int i;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
466
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
467 /* Copy all the contents. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
468 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
469 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
470 /* 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
471 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
472 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
473 XCHAR_TABLE (copy)->contents[i]
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
474 = 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
475
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
476 return copy;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
477 }
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
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 "Return a copy of a list, vector or string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 The elements of a list or vector are not copied; they are shared\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 with the original.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
487 if (NILP (arg)) return arg;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
488
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
489 if (CHAR_TABLE_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
490 {
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
491 int i;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
492 Lisp_Object copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
493
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
494 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
495 /* 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
496 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
497 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
498 * sizeof (Lisp_Object)));
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
499
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
500 /* 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
501 for multibyte characters. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
502 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
503 i < CHAR_TABLE_ORDINARY_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
504 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
505 XCHAR_TABLE (copy)->contents[i]
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
506 = 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
507
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
508 return copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
509 }
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 if (BOOL_VECTOR_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
512 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
513 Lisp_Object val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
514 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
515 = (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
516
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
517 val = Fmake_bool_vector (Flength (arg), Qnil);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
518 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
519 size_in_chars);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
520 return val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
521 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
522
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
523 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 arg = wrong_type_argument (Qsequencep, arg);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
525 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
526 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
528 /* 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
529 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
530 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
531 Otherwize, return 0. */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
532
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
533 static int
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
534 count_combining (str, len, i)
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
535 unsigned char *str;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
536 int len, i;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
537 {
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
538 int j = i - 1, bytes;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
539
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
540 if (i == 0 || i == len || CHAR_HEAD_P (str[i]))
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
541 return 0;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
542 while (j >= 0 && !CHAR_HEAD_P (str[j])) j--;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
543 if (j < 0 || ! BASE_LEADING_CODE_P (str[j]))
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
544 return 0;
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
545 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
546 return (bytes <= i - j ? 0 : bytes - (i - j));
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
547 }
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 /* 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
550 a string and has text properties to be copied. */
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
551 struct textprop_rec
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
552 {
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
553 int argnum; /* refer to ARGS (arguments of `concat') */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
554 int from; /* refer to ARGS[argnum] (argument string) */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
555 int to; /* refer to VAL (the target string) */
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
556 };
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
557
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 static Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559 concat (nargs, args, target_type, last_special)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
561 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
562 enum Lisp_Type target_type;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
563 int last_special;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
565 Lisp_Object val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
566 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 register Lisp_Object this;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
568 int toindex;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
569 int toindex_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
570 register int result_len;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
571 register int result_len_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
572 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
573 Lisp_Object last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
574 Lisp_Object prev;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
575 int some_multibyte;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
576 /* 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
577 while concatinating each string because the length of resulting
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
578 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
579 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
580 here, and copy the text properties after the concatination. */
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
581 struct textprop_rec *textprops;
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
582 /* Number of elments in textprops. */
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
583 int num_textprops = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
584
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
585 /* In append, the last arg isn't treated like the others */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
586 if (last_special && nargs > 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
587 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
588 nargs--;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
589 last_tail = args[nargs];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 last_tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
594 /* Canonicalize each argument. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
597 this = args[argnum];
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
598 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
599 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
600 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
601 if (INTEGERP (this))
11142
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
602 args[argnum] = Fnumber_to_string (this);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
603 else
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;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
636 if (this_len_byte > 1)
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;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
649 if (this_len_byte > 1)
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;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
657 result_len_byte += STRING_BYTES (XSTRING (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
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
660 result_len_byte += count_size_as_multibyte (XSTRING (this)->data,
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
661 XSTRING (this)->size);
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;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
699 int thisleni;
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 {
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
711 int thislen_byte = STRING_BYTES (XSTRING (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
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
714 bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
715 STRING_BYTES (XSTRING (this)));
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
716 combined = (some_multibyte && toindex_byte > 0
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
717 ? count_combining (XSTRING (val)->data,
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);
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
721 if (! NULL_INTERVAL_P (XSTRING (this)->intervals))
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;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
730 XSTRING (val)->size -= 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 {
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
735 if (! NULL_INTERVAL_P (XSTRING (this)->intervals))
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 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
741 toindex_byte += copy_text (XSTRING (this)->data,
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
742 XSTRING (val)->data + toindex_byte,
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
743 XSTRING (this)->size, 0, 1);
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 {
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
764 FETCH_STRING_CHAR_ADVANCE (c, this,
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
765 thisindex,
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
766 thisindex_byte);
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 {
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
771 XSETFASTINT (elt, XSTRING (this)->data[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 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
799 XCAR (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 {
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
807 CHECK_NUMBER (elt, 0);
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 {
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
810 XSTRING (val)->data[toindex_byte++] = XINT (elt);
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
811 if (some_multibyte
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
812 && toindex_byte > 0
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
813 && count_combining (XSTRING (val)->data,
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
814 toindex_byte, toindex_byte - 1))
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
815 XSTRING (val)->size--;
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
816 else
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
817 toindex++;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
818 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
819 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
820 /* 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
821 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
822 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
823 int c = XINT (elt);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
824 /* P exists as a variable
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
825 to avoid a bug on the Masscomp C compiler. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
826 unsigned char *p = & XSTRING (val)->data[toindex_byte];
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
827
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
828 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
829 toindex++;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
830 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
831 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
832 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
833 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
834 if (!NILP (prev))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
835 XCDR (prev) = last_tail;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
836
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
837 if (num_textprops > 0)
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
838 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
839 for (argnum = 0; argnum < num_textprops; argnum++)
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
840 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
841 this = args[textprops[argnum].argnum];
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
842 copy_text_properties (make_number (textprops[argnum].from),
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
843 XSTRING (this)->size, this,
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
844 make_number (textprops[argnum].to), val, Qnil);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
845 }
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
846 }
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
847 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
848 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
849
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
850 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
851 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
852 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
853
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
854 void
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
855 clear_string_char_byte_cache ()
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
856 {
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
857 string_char_byte_cache_string = Qnil;
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
858 }
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
859
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
860 /* 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
861
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
862 int
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
863 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
864 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
865 int char_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
866 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
867 int i, i_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
868 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
869 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
870
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
871 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
872 return char_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
873
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
874 best_below = best_below_byte = 0;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
875 best_above = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
876 best_above_byte = STRING_BYTES (XSTRING (string));
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
877
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
878 if (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
879 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
880 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
881 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
882 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
883 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
884 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
885 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
886 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
887 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
888 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
889 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
890 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
891
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
892 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
893 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
894 while (best_below < char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
895 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
896 int c;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
897 FETCH_STRING_CHAR_ADVANCE (c, string, best_below, best_below_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
898 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
899 i = best_below;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
900 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
901 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
902 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
903 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
904 while (best_above > char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
905 {
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
906 unsigned char *pend = XSTRING (string)->data + best_above_byte;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
907 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
908 unsigned char *p = pend - 1;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
909 int bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
910
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
911 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
912 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
913 if (bytes == pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
914 best_above_byte -= bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
915 else if (bytes > pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
916 best_above_byte -= (pend - p);
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
917 else
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
918 best_above_byte--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
919 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
920 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
921 i = best_above;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
922 i_byte = best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
923 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
924
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
925 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
926 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
927 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
928
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
929 return i_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
930 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
931
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
932 /* 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
933
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
934 int
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
935 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
936 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
937 int byte_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
938 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
939 int i, i_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
940 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
941 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
942
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
943 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
944 return byte_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
945
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
946 best_below = best_below_byte = 0;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
947 best_above = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
948 best_above_byte = STRING_BYTES (XSTRING (string));
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
949
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
950 if (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
951 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
952 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
953 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
954 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
955 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
956 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
957 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
958 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
959 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
960 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
961 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
962 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
963
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
964 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
965 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
966 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
967 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
968 int c;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
969 FETCH_STRING_CHAR_ADVANCE (c, string, best_below, best_below_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
970 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
971 i = best_below;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
972 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
973 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
974 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
975 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
976 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
977 {
25501
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
978 unsigned char *pend = XSTRING (string)->data + best_above_byte;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
979 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
980 unsigned char *p = pend - 1;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
981 int bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
982
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
983 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
984 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
985 if (bytes == pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
986 best_above_byte -= bytes;
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
987 else if (bytes > pend - p)
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
988 best_above_byte -= (pend - p);
9392c9b7dd07 (count_combining): Use the macro PARSE_MULTIBYTE_SEQ.
Kenichi Handa <handa@m17n.org>
parents: 25495
diff changeset
989 else
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
990 best_above_byte--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
991 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
992 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
993 i = best_above;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
994 i_byte = best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
995 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
996
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
997 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
998 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
999 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
1000
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1001 return i;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1002 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1003
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1004 /* Convert STRING to a multibyte string.
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
1005 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
1006 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
1007
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1008 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1009 string_make_multibyte (string)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1010 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1011 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1012 unsigned char *buf;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1013 int nbytes;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1014
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1015 if (STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1016 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1017
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1018 nbytes = count_size_as_multibyte (XSTRING (string)->data,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1019 XSTRING (string)->size);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1020 /* 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
1021 once converted. In that case, we can return STRING itself. */
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1022 if (nbytes == STRING_BYTES (XSTRING (string)))
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1023 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1024
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1025 buf = (unsigned char *) alloca (nbytes);
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1026 copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1027 0, 1);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1028
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1029 return make_multibyte_string (buf, XSTRING (string)->size, 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
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1032 /* 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
1033
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1034 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1035 string_make_unibyte (string)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1036 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1037 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1038 unsigned char *buf;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1039
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1040 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1041 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1042
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1043 buf = (unsigned char *) alloca (XSTRING (string)->size);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1044
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1045 copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1046 1, 0);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1047
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1048 return make_unibyte_string (buf, XSTRING (string)->size);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1049 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1050
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1051 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
1052 1, 1, 0,
21716
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
1053 "Return the multibyte equivalent of STRING.\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
1054 The function `unibyte-char-to-multibyte' is used to convert\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
1055 each unibyte character to a multibyte character.")
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1056 (string)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1057 Lisp_Object string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1058 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1059 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1060
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1061 return string_make_multibyte (string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1062 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1063
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1064 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
1065 1, 1, 0,
21716
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
1066 "Return the unibyte equivalent of STRING.\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
1067 Multibyte character codes are converted to unibyte\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
1068 by using just the low 8 bits.")
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1069 (string)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1070 Lisp_Object string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1071 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1072 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1073
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1074 return string_make_unibyte (string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
1075 }
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1076
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1077 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
1078 1, 1, 0,
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1079 "Return a unibyte string with the same individual bytes as STRING.\n\
23773
f11f551fee99 (Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents: 23733
diff changeset
1080 If STRING is unibyte, the result is STRING itself.\n\
f11f551fee99 (Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents: 23733
diff changeset
1081 Otherwise it is a newly created string, with no text properties.")
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1082 (string)
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1083 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
1084 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1085 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1086
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1087 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
1088 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1089 string = Fcopy_sequence (string);
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1090 XSTRING (string)->size = STRING_BYTES (XSTRING (string));
23773
f11f551fee99 (Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents: 23733
diff changeset
1091 XSTRING (string)->intervals = NULL_INTERVAL;
21374
456146137d23 (Fstring_as_unibyte): Set size_byte field to -1.
Kenichi Handa <handa@m17n.org>
parents: 21342
diff changeset
1092 SET_STRING_BYTES (XSTRING (string), -1);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1093 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1094 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1095 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1096
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1097 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
1098 1, 1, 0,
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1099 "Return a multibyte string with the same individual bytes as STRING.\n\
23773
f11f551fee99 (Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents: 23733
diff changeset
1100 If STRING is multibyte, the result is STRING itself.\n\
f11f551fee99 (Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents: 23733
diff changeset
1101 Otherwise it is a newly created string, with no text properties.")
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1102 (string)
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1103 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
1104 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1105 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1106
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1107 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
1108 {
21342
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1109 int nbytes = STRING_BYTES (XSTRING (string));
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1110 int newlen = multibyte_chars_in_text (XSTRING (string)->data, nbytes);
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1111
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1112 string = Fcopy_sequence (string);
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1113 XSTRING (string)->size = newlen;
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1114 XSTRING (string)->size_byte = nbytes;
23773
f11f551fee99 (Fstring_as_unibyte, Fstring_as_multibyte):
Richard M. Stallman <rms@gnu.org>
parents: 23733
diff changeset
1115 XSTRING (string)->intervals = 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
1116 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1117 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1118 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1119
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1120 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1121 "Return a copy of ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1122 This is an alist which represents the same mapping from objects to objects,\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1123 but does not share the alist structure with ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1124 The objects mapped (cars and cdrs of elements of the alist)\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1125 are shared, however.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1126 Elements of ALIST that are not conses are also shared.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1127 (alist)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1128 Lisp_Object alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1129 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1130 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1131
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1132 CHECK_LIST (alist, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1133 if (NILP (alist))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1134 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1135 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
1136 for (tem = alist; CONSP (tem); tem = XCDR (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1137 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1138 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
1139 car = XCAR (tem);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1140
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1141 if (CONSP (car))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1142 XCAR (tem) = Fcons (XCAR (car), XCDR (car));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1143 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1144 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1145 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1146
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1147 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1148 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1149 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1150 If FROM or TO is negative, it counts from the end.\n\
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1151 \n\
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1152 This function allows vectors as well as strings.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1153 (string, from, to)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1154 Lisp_Object string;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1155 register Lisp_Object from, to;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1156 {
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1157 Lisp_Object res;
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1158 int size;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1159 int size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1160 int from_char, to_char;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1161 int from_byte, to_byte;
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1162
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1163 if (! (STRINGP (string) || VECTORP (string)))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1164 wrong_type_argument (Qarrayp, string);
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1165
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1166 CHECK_NUMBER (from, 1);
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1167
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1168 if (STRINGP (string))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1169 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1170 size = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1171 size_byte = STRING_BYTES (XSTRING (string));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1172 }
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1173 else
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1174 size = XVECTOR (string)->size;
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1175
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1176 if (NILP (to))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1177 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1178 to_char = size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1179 to_byte = size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1180 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1181 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1182 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1183 CHECK_NUMBER (to, 2);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1184
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1185 to_char = XINT (to);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1186 if (to_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1187 to_char += size;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1188
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1189 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1190 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
1191 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1192
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1193 from_char = XINT (from);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1194 if (from_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1195 from_char += size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1196 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1197 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
1198
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1199 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
1200 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
1201 make_number (to_char));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1202
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1203 if (STRINGP (string))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1204 {
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1205 res = make_specified_string (XSTRING (string)->data + from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1206 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
1207 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1208 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
1209 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
1210 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1211 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1212 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
1213 XVECTOR (string)->contents + from_char);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1214
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1215 return res;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1216 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1217
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1218 /* 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
1219 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
1220
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1221 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1222 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
1223 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1224 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
1225 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1226 Lisp_Object res;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1227 int size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1228 int size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1229
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1230 if (! (STRINGP (string) || VECTORP (string)))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1231 wrong_type_argument (Qarrayp, string);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1232
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1233 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1234 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1235 size = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1236 size_byte = STRING_BYTES (XSTRING (string));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1237 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1238 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1239 size = XVECTOR (string)->size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1240
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1241 if (!(0 <= from && from <= to && to <= size))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1242 args_out_of_range_3 (string, make_number (from), make_number (to));
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1243
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1244 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1245 {
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1246 res = make_specified_string (XSTRING (string)->data + from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1247 to - from, to_byte - from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1248 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1249 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
1250 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
1251 }
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1252 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1253 res = Fvector (to - from,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1254 XVECTOR (string)->contents + from);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1255
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1256 return res;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1257 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1258
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1259 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1260 "Take cdr N times on LIST, returns the result.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1261 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1262 Lisp_Object n;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1263 register Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1264 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1265 register int i, num;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1266 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1267 num = XINT (n);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1268 for (i = 0; i < num && !NILP (list); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1269 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1270 QUIT;
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1271 if (! CONSP (list))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1272 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1273 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1274 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1275 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1276 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1277
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1278 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1279 "Return the Nth element of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1280 N counts from zero. If LIST is not that long, nil is returned.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1281 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1282 Lisp_Object n, list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1283 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1284 return Fcar (Fnthcdr (n, list));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1285 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1286
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1287 DEFUN ("elt", Felt, Selt, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1288 "Return element of SEQUENCE at index N.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1289 (sequence, n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1290 register Lisp_Object sequence, n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1291 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1292 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1293 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1294 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1295 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
1296 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
1297 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
1298 || 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
1299 return Faref (sequence, n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1300 else
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1301 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1302 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1303 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1304
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1305 DEFUN ("member", Fmember, Smember, 2, 2, 0,
6990
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1306 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1307 The value is actually the tail of LIST whose car is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1308 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1309 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1310 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1311 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1312 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
1313 for (tail = list; !NILP (tail); tail = XCDR (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1314 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1315 register Lisp_Object tem;
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1316 if (! CONSP (tail))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1317 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1318 tem = XCAR (tail);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1319 if (! NILP (Fequal (elt, tem)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1320 return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1321 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1322 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1323 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1325
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1326 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1327 "Return non-nil if ELT is an element of LIST.\n\
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1328 Comparison done with EQ. The value is actually the tail of LIST\n\
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1329 whose car is ELT.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1330 (elt, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1331 Lisp_Object elt, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1332 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1333 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1334 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1335 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1336 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1337
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1338 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1339 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1340 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1341
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1342 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1343 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1344 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1345
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1346 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1347 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1348 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1349
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1350 if (!CONSP (list) && !NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1351 list = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1352
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1353 return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1354 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1355
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1356 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
1357 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
1358 The value is actually the element of LIST whose car is KEY.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1359 Elements of LIST that are not conses are ignored.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1360 (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1361 Lisp_Object key, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1362 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1363 Lisp_Object result;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1364
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1365 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1366 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1367 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1368 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1369 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1370 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1371
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1372 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1373 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1374 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1375 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1376 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1377
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1378 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1379 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1380 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1381 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1382 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1383
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1384 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1385 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1386 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1387
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1388 if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1389 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1390 else if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1391 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1392 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1393 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1394
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1395 return result;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1396 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1397
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1398 /* Like Fassq but never report an error and do not allow quits.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1399 Use only on lists known never to be circular. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1400
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1401 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1402 assq_no_quit (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1403 Lisp_Object key, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1404 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1405 while (CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1406 && (!CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1407 || !EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1408 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1409
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1410 return CONSP (list) ? XCAR (list) : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1411 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1412
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1413 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
1414 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1415 The value is actually the element of LIST whose car equals KEY.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1416 (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1417 Lisp_Object key, list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1418 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1419 Lisp_Object result, car;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1420
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1421 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1423 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1424 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1425 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1426 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1427 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1428
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1429 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1430 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1431 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1432 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1433 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1434 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1435
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1436 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1437 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1438 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1439 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1440 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1441 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1442
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1443 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1444 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1445 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1446
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1447 if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1448 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1449 else if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1450 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1451 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1452 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1453
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1454 return result;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1455 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1456
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1457 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1458 "Return non-nil if KEY is `eq' to the cdr of an element of LIST.\n\
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1459 The value is actually the element of LIST whose cdr is KEY.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1460 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1461 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1462 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1463 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1464 Lisp_Object result;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1465
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1466 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1468 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1469 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1470 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1471 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1472
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1473 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1474 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1475 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1476 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1477 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1478
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1479 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1480 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1481 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1482 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1483 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1484
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1485 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1486 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1487 }
26230
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 if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1490 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1491 else if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1492 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1493 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1494 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1495
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1496 return result;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1497 }
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1498
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1499 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1500 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1501 The value is actually the element of LIST whose cdr equals KEY.")
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1502 (key, list)
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1503 Lisp_Object key, list;
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1504 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1505 Lisp_Object result, cdr;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1506
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1507 while (1)
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1508 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1509 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1510 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1511 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1512 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1513 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1514
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1515 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1516 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1517 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1518 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1519 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1520 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1521
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1522 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1523 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1524 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1525 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1526 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1527 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1528
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1529 list = XCDR (list);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1530 QUIT;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1531 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1532
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1533 if (CONSP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1534 result = XCAR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1535 else if (NILP (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1536 result = Qnil;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1537 else
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1538 result = wrong_type_argument (Qlistp, list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1539
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1540 return result;
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1541 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1542
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1543 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1544 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1545 The modified LIST is returned. Comparison is done with `eq'.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1546 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1547 therefore, write `(setq foo (delq element foo))'\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1548 to be sure of changing the value of `foo'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1550 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1551 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1552 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1553 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1554 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1555
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1556 tail = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1557 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1558 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1559 {
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1560 if (! CONSP (tail))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1561 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1562 tem = XCAR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1563 if (EQ (elt, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1564 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1565 if (NILP (prev))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1566 list = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1567 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1568 Fsetcdr (prev, XCDR (tail));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1569 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1570 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1571 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1572 tail = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1573 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1574 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1575 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1576 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1577
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
1578 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1579 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1580 The modified LIST is returned. Comparison is done with `equal'.\n\
6990
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1581 If the first member of LIST is ELT, deleting it is not a side effect;\n\
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1582 it is simply using a different list.\n\
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1583 Therefore, write `(setq foo (delete element foo))'\n\
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1584 to be sure of changing the value of `foo'.")
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1585 (elt, list)
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1586 register Lisp_Object elt;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1587 Lisp_Object list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1588 {
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1589 register Lisp_Object tail, prev;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1590 register Lisp_Object tem;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1591
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1592 tail = list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1593 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1594 while (!NILP (tail))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1595 {
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1596 if (! CONSP (tail))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1597 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1598 tem = XCAR (tail);
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
1599 if (! NILP (Fequal (elt, tem)))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1600 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1601 if (NILP (prev))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1602 list = XCDR (tail);
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1603 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1604 Fsetcdr (prev, XCDR (tail));
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1605 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1606 else
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1607 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1608 tail = XCDR (tail);
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1609 QUIT;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1610 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1611 return list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1612 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1613
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1614 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1615 "Reverse LIST by modifying cdr pointers.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1616 Returns the beginning of the reversed list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1617 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1618 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1619 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1620 register Lisp_Object prev, tail, next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1621
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1622 if (NILP (list)) return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1623 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1624 tail = list;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1625 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1626 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1627 QUIT;
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1628 if (! CONSP (tail))
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1629 wrong_type_argument (Qlistp, list);
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1630 next = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1631 Fsetcdr (tail, prev);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1632 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1633 tail = next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1635 return prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1636 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1637
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1638 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1639 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1640 See also the function `nreverse', which is used more often.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1641 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1642 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1643 {
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1644 Lisp_Object new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1645
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1646 for (new = Qnil; CONSP (list); list = XCDR (list))
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1647 new = Fcons (XCAR (list), new);
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1648 if (!NILP (list))
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1649 wrong_type_argument (Qconsp, list);
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1650 return new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1651 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1652
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1653 Lisp_Object merge ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1654
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1655 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1656 "Sort LIST, stably, comparing elements using PREDICATE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1657 Returns the sorted list. LIST is modified by side effects.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1658 PREDICATE is called with two elements of LIST, and should return T\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1659 if the first element is \"less\" than the second.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1660 (list, predicate)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1661 Lisp_Object list, predicate;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1662 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1663 Lisp_Object front, back;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1664 register Lisp_Object len, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1665 struct gcpro gcpro1, gcpro2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1666 register int length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1667
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1668 front = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1669 len = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1670 length = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1671 if (length < 2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1672 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1673
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1674 XSETINT (len, (length / 2) - 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1675 tem = Fnthcdr (len, list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1676 back = Fcdr (tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1677 Fsetcdr (tem, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1678
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1679 GCPRO2 (front, back);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1680 front = Fsort (front, predicate);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1681 back = Fsort (back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1682 UNGCPRO;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1683 return merge (front, back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1684 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1685
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1686 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1687 merge (org_l1, org_l2, pred)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1688 Lisp_Object org_l1, org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1689 Lisp_Object pred;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1691 Lisp_Object value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1692 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1693 Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1694 register Lisp_Object l1, l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1695 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1696
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1697 l1 = org_l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1698 l2 = org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1699 tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1700 value = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1701
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1702 /* It is sufficient to protect org_l1 and org_l2.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1703 When l1 and l2 are updated, we copy the new values
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1704 back into the org_ vars. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1705 GCPRO4 (org_l1, org_l2, pred, value);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1706
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1707 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1708 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1709 if (NILP (l1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1710 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1711 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1712 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1713 return l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1714 Fsetcdr (tail, l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1715 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1716 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1717 if (NILP (l2))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1718 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1720 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1721 return l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1722 Fsetcdr (tail, l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1723 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1724 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1725 tem = call2 (pred, Fcar (l2), Fcar (l1));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1726 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1727 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1728 tem = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1729 l1 = Fcdr (l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1730 org_l1 = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1731 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1732 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1733 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1734 tem = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1735 l2 = Fcdr (l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1736 org_l2 = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1737 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1738 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1739 value = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1740 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1741 Fsetcdr (tail, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1742 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1743 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1744 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1745
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1746
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1747 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
1748 "Extract a value from a property list.\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1749 PLIST is a property list, which is a list of the form\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1750 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1751 corresponding to the given PROP, or nil if PROP is not\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1752 one of the properties on the list.")
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
1753 (plist, prop)
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
1754 Lisp_Object plist;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1755 register Lisp_Object prop;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1756 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1757 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
1758 for (tail = plist; !NILP (tail); tail = Fcdr (XCDR (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1759 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1760 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1761 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1762 if (EQ (prop, tem))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1763 return Fcar (XCDR (tail));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1766 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1768 DEFUN ("get", Fget, Sget, 2, 2, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1769 "Return the value of SYMBOL's PROPNAME property.\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1770 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1771 (symbol, propname)
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1772 Lisp_Object symbol, propname;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1773 {
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1774 CHECK_SYMBOL (symbol, 0);
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1775 return Fplist_get (XSYMBOL (symbol)->plist, propname);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1776 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1777
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1778 DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1779 "Change value in PLIST of PROP to VAL.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1780 PLIST is a property list, which is a list of the form\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1781 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1782 If PROP is already a property on the list, its value is set to VAL,\n\
11221
254a5316fc98 (Fplist_put): Fix missing \n\.
Karl Heuer <kwzh@gnu.org>
parents: 11194
diff changeset
1783 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1784 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1785 The PLIST is modified by side effects.")
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1786 (plist, prop, val)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1787 Lisp_Object plist;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1788 register Lisp_Object prop;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1789 Lisp_Object val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1790 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792 Lisp_Object newcell;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1793 prev = Qnil;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1794 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
1795 tail = XCDR (XCDR (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1797 if (EQ (prop, XCAR (tail)))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1798 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1799 Fsetcar (XCDR (tail), val);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1800 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1801 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1802 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1803 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1804 newcell = Fcons (prop, Fcons (val, Qnil));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1805 if (NILP (prev))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1806 return newcell;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1807 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1808 Fsetcdr (XCDR (prev), newcell);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1809 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1810 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1811
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1812 DEFUN ("put", Fput, Sput, 3, 3, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1813 "Store SYMBOL's PROPNAME property with value VALUE.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1814 It can be retrieved with `(get SYMBOL PROPNAME)'.")
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1815 (symbol, propname, value)
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1816 Lisp_Object symbol, propname, value;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1817 {
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1818 CHECK_SYMBOL (symbol, 0);
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1819 XSYMBOL (symbol)->plist
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1820 = 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
1821 return value;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1822 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1823
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1824 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1825 "Return t if two Lisp objects have similar structure and contents.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1826 They must have the same data type.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1827 Conses are compared by comparing the cars and the cdrs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1828 Vectors and strings are compared element by element.\n\
3379
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
1829 Numbers are compared by value, but integers cannot equal floats.\n\
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
1830 (Use `=' if you want integers and floats to be able to be equal.)\n\
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
1831 Symbols must match exactly.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1832 (o1, o2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1833 register Lisp_Object o1, o2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1834 {
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1835 return internal_equal (o1, o2, 0) ? Qt : Qnil;
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1836 }
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1837
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1838 static int
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1839 internal_equal (o1, o2, depth)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1840 register Lisp_Object o1, o2;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1841 int depth;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1842 {
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1843 if (depth > 200)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1844 error ("Stack overflow in equal");
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1845
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1846 tail_recurse:
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1847 QUIT;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1848 if (EQ (o1, o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1849 return 1;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1850 if (XTYPE (o1) != XTYPE (o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1851 return 0;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1852
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1853 switch (XTYPE (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1854 {
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1855 case Lisp_Float:
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1856 return (extract_float (o1) == extract_float (o2));
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1857
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1858 case Lisp_Cons:
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1859 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1860 return 0;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1861 o1 = XCDR (o1);
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1862 o2 = XCDR (o2);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1863 goto tail_recurse;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1864
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1865 case Lisp_Misc:
11240
2642924d2d21 (internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
1866 if (XMISCTYPE (o1) != XMISCTYPE (o2))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1867 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1868 if (OVERLAYP (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1869 {
25149
ee483f870bde (internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents: 25094
diff changeset
1870 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1871 depth + 1)
25149
ee483f870bde (internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents: 25094
diff changeset
1872 || !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
1873 depth + 1))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1874 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1875 o1 = XOVERLAY (o1)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1876 o2 = XOVERLAY (o2)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1877 goto tail_recurse;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1878 }
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1879 if (MARKERP (o1))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1880 {
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1881 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
1882 && (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
1883 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1884 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1885 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1886
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1887 case Lisp_Vectorlike:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1888 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1889 register int i, size;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1890 size = XVECTOR (o1)->size;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1891 /* 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
1892 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
1893 same size. */
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1894 if (XVECTOR (o2)->size != size)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1895 return 0;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1896 /* Boolvectors are compared much like strings. */
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1897 if (BOOL_VECTOR_P (o1))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1898 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1899 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
1900 = (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
1901
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1902 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
1903 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1904 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
1905 size_in_chars))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1906 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1907 return 1;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1908 }
20776
219fdecc30d3 (internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents: 20712
diff changeset
1909 if (WINDOW_CONFIGURATIONP (o1))
21021
7be2384fabdc (internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents: 20992
diff changeset
1910 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
1911
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1912 /* 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
1913 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
1914 if (size & PSEUDOVECTOR_FLAG)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1915 {
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1916 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1917 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1918 size &= PSEUDOVECTOR_SIZE_MASK;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1919 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1920 for (i = 0; i < size; i++)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1921 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1922 Lisp_Object v1, v2;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1923 v1 = XVECTOR (o1)->contents [i];
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1924 v2 = XVECTOR (o2)->contents [i];
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1925 if (!internal_equal (v1, v2, depth + 1))
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1926 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1927 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1928 return 1;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1929 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1930 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1931
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1932 case Lisp_String:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1933 if (XSTRING (o1)->size != XSTRING (o2)->size)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1934 return 0;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1935 if (STRING_BYTES (XSTRING (o1)) != STRING_BYTES (XSTRING (o2)))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1936 return 0;
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1937 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data,
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1938 STRING_BYTES (XSTRING (o1))))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1939 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1940 return 1;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 }
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1942 return 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1943 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1944
18613
614b916ff5bf Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents: 18531
diff changeset
1945 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
1946
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1947 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1948 "Store each element of ARRAY with ITEM.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1949 ARRAY is a vector, string, char-table, or bool-vector.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1950 (array, item)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1951 Lisp_Object array, item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 register int size, index, charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1954 retry:
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1955 if (VECTORP (array))
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 register Lisp_Object *p = XVECTOR (array)->contents;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1958 size = XVECTOR (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1959 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1960 p[index] = item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1961 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1962 else if (CHAR_TABLE_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1963 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1964 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
1965 size = CHAR_TABLE_ORDINARY_SLOTS;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1966 for (index = 0; index < size; index++)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1967 p[index] = item;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1968 XCHAR_TABLE (array)->defalt = Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1969 }
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1970 else if (STRINGP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1971 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1972 register unsigned char *p = XSTRING (array)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1973 CHECK_NUMBER (item, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1974 charval = XINT (item);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 size = XSTRING (array)->size;
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1976 if (STRING_MULTIBYTE (array))
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1977 {
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
1978 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
1979 int len = CHAR_STRING (charval, str);
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1980 int size_byte = STRING_BYTES (XSTRING (array));
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1981 unsigned char *p1 = p, *endp = p + size_byte;
23453
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1982 int i;
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1983
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1984 if (size != size_byte)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1985 while (p1 < endp)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1986 {
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1987 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1);
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1988 if (len != this_len)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1989 error ("Attempt to change byte length of a string");
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1990 p1 += this_len;
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
1991 }
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1992 for (i = 0; i < size_byte; i++)
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1993 *p++ = str[i % len];
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1994 }
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1995 else
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1996 for (index = 0; index < size; index++)
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
1997 p[index] = charval;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1998 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1999 else if (BOOL_VECTOR_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2000 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2001 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
2002 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
2003 = (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
2004
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2005 charval = (! NILP (item) ? -1 : 0);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2006 for (index = 0; index < size_in_chars; index++)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2007 p[index] = charval;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2008 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2009 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2010 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2011 array = wrong_type_argument (Qarrayp, array);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2014 return array;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2015 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2016
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2017 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
2018 1, 1, 0,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2019 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2020 (char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2021 Lisp_Object char_table;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2022 {
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2023 CHECK_CHAR_TABLE (char_table, 0);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2024
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2025 return XCHAR_TABLE (char_table)->purpose;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2026 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2027
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2028 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
2029 1, 1, 0,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2030 "Return the parent char-table of CHAR-TABLE.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2031 The value is either nil or another char-table.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2032 If CHAR-TABLE holds nil for a given character,\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2033 then the actual applicable value is inherited from the parent char-table\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2034 \(or from its parents, if necessary).")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2035 (char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2036 Lisp_Object char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2037 {
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2038 CHECK_CHAR_TABLE (char_table, 0);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2039
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2040 return XCHAR_TABLE (char_table)->parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2041 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2042
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2043 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
2044 2, 2, 0,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2045 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2046 PARENT must be either nil or another char-table.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2047 (char_table, parent)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2048 Lisp_Object char_table, parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2049 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2050 Lisp_Object temp;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2051
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2052 CHECK_CHAR_TABLE (char_table, 0);
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2053
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2054 if (!NILP (parent))
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2055 {
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2056 CHECK_CHAR_TABLE (parent, 0);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2057
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2058 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
2059 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
2060 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
2061 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2062
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2063 XCHAR_TABLE (char_table)->parent = parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2064
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2065 return parent;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2066 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2067
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2068 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
2069 2, 2, 0,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
2070 "Return the value of CHAR-TABLE's extra-slot number N.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2071 (char_table, n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2072 Lisp_Object char_table, n;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2073 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2074 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2075 CHECK_NUMBER (n, 2);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2076 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
2077 || 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
2078 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
2079
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2080 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
2081 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2082
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2083 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
2084 Sset_char_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2085 3, 3, 0,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
2086 "Set CHAR-TABLE's extra-slot number N to VALUE.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2087 (char_table, n, value)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2088 Lisp_Object char_table, n, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2089 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2090 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2091 CHECK_NUMBER (n, 2);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2092 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
2093 || 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
2094 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
2095
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2096 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
2097 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2098
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2099 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
2100 2, 2, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2101 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2102 RANGE should be nil (for the default value)\n\
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2103 a vector which identifies a character set or a row of a character set,\n\
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2104 a character set name, or a character code.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2105 (char_table, range)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2106 Lisp_Object char_table, range;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2107 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2108 CHECK_CHAR_TABLE (char_table, 0);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2109
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2110 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
2111 return XCHAR_TABLE (char_table)->defalt;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2112 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
2113 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
2114 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
2115 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2116 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
2117
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2118 charset_info = Fget (range, Qcharset);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2119 CHECK_VECTOR (charset_info, 0);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2120
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2121 return Faref (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2122 make_number (XINT (XVECTOR (charset_info)->contents[0])
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2123 + 128));
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2124 }
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2125 else if (VECTORP (range))
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2126 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2127 if (XVECTOR (range)->size == 1)
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2128 return Faref (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2129 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
2130 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2131 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2132 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2133 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2134 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
2135 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2136 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2137 return Faref (char_table, ch);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2138 }
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2139 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2140 else
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2141 error ("Invalid RANGE argument to `char-table-range'");
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2142 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2143
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2144 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
2145 3, 3, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2146 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2147 RANGE should be t (for all characters), nil (for the default value)\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2148 a vector which identifies a character set or a row of a character set,\n\
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2149 a coding system, or a character code.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2150 (char_table, range, value)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2151 Lisp_Object char_table, range, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2152 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2153 int i;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2154
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2155 CHECK_CHAR_TABLE (char_table, 0);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2156
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2157 if (EQ (range, Qt))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2158 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
2159 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
2160 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
2161 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
2162 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
2163 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2164 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
2165
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2166 charset_info = Fget (range, Qcharset);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2167 CHECK_VECTOR (charset_info, 0);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2168
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2169 return Faset (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2170 make_number (XINT (XVECTOR (charset_info)->contents[0])
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2171 + 128),
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2172 value);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
2173 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2174 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
2175 Faset (char_table, range, value);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2176 else if (VECTORP (range))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2177 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2178 if (XVECTOR (range)->size == 1)
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2179 return Faset (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2180 make_number (XINT (XVECTOR (range)->contents[0]) + 128),
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
2181 value);
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2182 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2183 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2184 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2185 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2186 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
2187 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2188 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2189 return Faset (char_table, ch, value);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
2190 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2191 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2192 else
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2193 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
2194
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2195 return value;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2196 }
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2197
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2198 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
2199 Sset_char_table_default, 3, 3, 0,
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2200 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2201 The generic character specifies the group of characters.\n\
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2202 See also the documentation of make-char.")
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2203 (char_table, ch, value)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2204 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
2205 {
25709
ba4e2a641663 (SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents: 25690
diff changeset
2206 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
2207 Lisp_Object temp;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2208
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2209 CHECK_CHAR_TABLE (char_table, 0);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2210 CHECK_NUMBER (ch, 1);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2211
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2212 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
2213 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
2214
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2215 /* 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
2216 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
2217 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
2218 if (! CHARSET_VALID_P (charset))
22706
27a8a6847be2 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 22701
diff changeset
2219 invalid_character (c);
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2220
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2221 if (charset == CHARSET_ASCII)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2222 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
2223
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2224 /* 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
2225 generic char is specified. */
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
2226 if (CHARSET_DIMENSION (charset) == 1)
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2227 code1 = 0;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2228 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
2229 if (!code1)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2230 {
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2231 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
2232 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2233 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2234 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
2235 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2236 }
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2237 char_table = temp;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2238 if (! SUB_CHAR_TABLE_P (char_table))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2239 char_table = (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
2240 = make_sub_char_table (temp));
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2241 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
2242 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
2243 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2244 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2245 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
2246 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2247 }
21339
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2248
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2249 /* 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
2250 and return it as an integer.
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2251 If the element is nil, return CH itself.
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2252 (Actually we do that for any non-integer.) */
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2253
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2254 int
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2255 char_table_translate (table, ch)
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2256 Lisp_Object table;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2257 int ch;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2258 {
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2259 Lisp_Object value;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2260 value = Faref (table, make_number (ch));
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2261 if (! INTEGERP (value))
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2262 return ch;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2263 return XINT (value);
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2264 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2265
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2266 /* 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
2267 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
2268 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
2269 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
2270 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
2271
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2272 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
2273
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2274 void
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2275 map_char_table (c_function, function, subtable, arg, depth, indices)
20314
3fb425cf6a83 * fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents: 20148
diff changeset
2276 void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
3fb425cf6a83 * fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents: 20148
diff changeset
2277 Lisp_Object function, subtable, arg, *indices;
16105
1712db4a1709 (map_char_table): Declare depth as int.
Richard M. Stallman <rms@gnu.org>
parents: 15966
diff changeset
2278 int depth;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2279 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2280 int i, to;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2281
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2282 if (depth == 0)
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2283 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2284 /* 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
2285 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
2286 {
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2287 Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2288 if (c_function)
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2289 (*c_function) (arg, make_number (i), elt);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2290 else
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2291 call2 (function, make_number (i), elt);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2292 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2293 #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
2294 we should report them. */
20148
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2295 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
2296 return;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2297 #endif
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2298 to = CHAR_TABLE_ORDINARY_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2299 }
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2300 else
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2301 {
20148
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2302 i = 32;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2303 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2304 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2305
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2306 for (; i < to; i++)
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2307 {
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2308 Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2309
18108
af791b0f0657 (map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents: 18035
diff changeset
2310 XSETFASTINT (indices[depth], i);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2311
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2312 if (SUB_CHAR_TABLE_P (elt))
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2313 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2314 if (depth >= 3)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2315 error ("Too deep char table");
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2316 map_char_table (c_function, function, elt, arg, depth + 1, indices);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2317 }
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2318 else
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2319 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2320 int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2321
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2322 if (CHARSET_DEFINED_P (charset))
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2323 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2324 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2325 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2326 c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2327 if (c_function)
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2328 (*c_function) (arg, make_number (c), elt);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2329 else
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2330 call2 (function, make_number (c), elt);
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2331 }
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2332 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2333 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2334 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2335
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2336 DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2337 2, 2, 0,
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2338 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2339 FUNCTION is called with two arguments--a key and a value.\n\
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2340 The key is always a possible IDX argument to `aref'.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2341 (function, char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2342 Lisp_Object function, char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2343 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2344 /* 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
2345 Lisp_Object indices[3];
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2346
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2347 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2348
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2349 map_char_table (NULL, function, char_table, char_table, 0, indices);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2350 return Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2351 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2352
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2355 nconc2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2356 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2357 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2358 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2359 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2360 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2361 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2362 return Fnconc (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2363 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2364 return Fnconc (2, &s1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2365 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2366 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2367
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2368 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2369 "Concatenate any number of lists by altering them.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2370 Only the last argument is not altered, and need not be a list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2371 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2372 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2373 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2374 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2375 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2376 register Lisp_Object tail, tem, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2377
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2378 val = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2379
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2380 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2381 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2382 tem = args[argnum];
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2383 if (NILP (tem)) continue;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2384
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2385 if (NILP (val))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2386 val = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2387
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2388 if (argnum + 1 == nargs) break;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2389
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2390 if (!CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2391 tem = wrong_type_argument (Qlistp, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2392
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2393 while (CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2394 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2395 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2396 tem = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2397 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2398 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2399
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2400 tem = args[argnum + 1];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2401 Fsetcdr (tail, tem);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2402 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2403 args[argnum + 1] = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2404 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2405
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2406 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2407 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2408
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2409 /* 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
2410 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
2411 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
2412 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
2413
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2414 static void
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2415 mapcar1 (leni, vals, fn, seq)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2416 int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2417 Lisp_Object *vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2418 Lisp_Object fn, seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2419 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2420 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2421 Lisp_Object dummy;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2422 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2423 struct gcpro gcpro1, gcpro2, gcpro3;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2424
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2425 /* Don't let vals contain any garbage when GC happens. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2426 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2427 vals[i] = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2428
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2429 GCPRO3 (dummy, fn, seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2430 gcpro1.var = vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2431 gcpro1.nvars = leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2432 /* 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
2433 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
2434
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2435 if (VECTORP (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2436 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2437 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2438 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2439 dummy = XVECTOR (seq)->contents[i];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2440 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2441 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2442 }
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2443 else if (BOOL_VECTOR_P (seq))
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2444 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2445 for (i = 0; i < leni; i++)
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2446 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2447 int byte;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2448 byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR];
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2449 if (byte & (1 << (i % BITS_PER_CHAR)))
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2450 dummy = Qt;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2451 else
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2452 dummy = Qnil;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2453
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2454 vals[i] = call1 (fn, dummy);
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2455 }
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2456 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2457 else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2458 {
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2459 /* Single-byte string. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2460 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2461 {
9308
2c594629baaa (Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9289
diff changeset
2462 XSETFASTINT (dummy, XSTRING (seq)->data[i]);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2463 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2464 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2465 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2466 else if (STRINGP (seq))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2467 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2468 /* Multi-byte string. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2469 int i_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2470
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2471 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
2472 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2473 int c;
20712
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2474 int i_before = i;
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2475
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2476 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
2477 XSETFASTINT (dummy, c);
20712
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2478 vals[i_before] = call1 (fn, dummy);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2479 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2480 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2481 else /* Must be a list, since Flength did not get an error */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2482 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2483 tail = seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2484 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2485 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2486 vals[i] = call1 (fn, Fcar (tail));
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2487 tail = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2488 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2489 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2490
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2491 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2492 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2493
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2494 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2495 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2496 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2497 SEPARATOR results in spaces between the values returned by FUNCTION.\n\
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2498 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2499 (function, sequence, separator)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2500 Lisp_Object function, sequence, separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2501 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2502 Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2503 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2504 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2505 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2506 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2507 struct gcpro gcpro1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2508
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2509 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2510 leni = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2511 nargs = leni + leni - 1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2512 if (nargs < 0) return build_string ("");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2513
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2514 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2515
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2516 GCPRO1 (separator);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2517 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2518 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2519
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2520 for (i = leni - 1; i >= 0; i--)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2521 args[i + i] = args[i];
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2522
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2523 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
2524 args[i] = separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2525
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2526 return Fconcat (nargs, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2527 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2528
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2529 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2530 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2531 The result is a list just as long as SEQUENCE.\n\
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2532 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2533 (function, sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2534 Lisp_Object function, sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2535 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2536 register Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2537 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2538 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2539
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2540 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2541 leni = XFASTINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2542 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2543
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2544 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2545
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2546 return Flist (leni, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2547 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2548
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2549 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2550
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2551 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2552 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
759
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2553 Takes one argument, which is the string to display to ask the question.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2554 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2555 No confirmation of the answer is requested; a single character is enough.\n\
25071
31cd7d7a54df (Fy_or_n_p): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 25005
diff changeset
2556 Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses\n\
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
2557 the bindings in `query-replace-map'; see the documentation of that variable\n\
25071
31cd7d7a54df (Fy_or_n_p): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 25005
diff changeset
2558 for more information. In this case, the useful bindings are `act', `skip',\n\
31cd7d7a54df (Fy_or_n_p): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 25005
diff changeset
2559 `recenter', and `quit'.\)\n\
24280
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2560 \n\
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2561 Under a windowing system a dialog box will be used if `last-nonmenu-event'\n\
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2562 is nil.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2563 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2564 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2565 {
25071
31cd7d7a54df (Fy_or_n_p): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 25005
diff changeset
2566 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
2567 register int answer;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2568 Lisp_Object xprompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2569 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2570 struct gcpro gcpro1, gcpro2;
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2571 int count = specpdl_ptr - specpdl;
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2572
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2573 specbind (Qcursor_in_echo_area, Qt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2574
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2575 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
2576
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2577 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2578 xprompt = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2579 GCPRO2 (prompt, xprompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2580
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2581 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2582 {
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2583
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
2584 #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
2585 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
2586 && 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
2587 && 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
2588 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2589 Lisp_Object pane, menu;
7815
5d167db8ce8a (Fy_or_n_p, Fyes_or_no_p) [HAVE_X_MENU]: Redisplay before popping up a menu.
Karl Heuer <kwzh@gnu.org>
parents: 7790
diff changeset
2590 redisplay_preserve_echo_area ();
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
2591 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
2592 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
2593 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
2594 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
2595 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
2596 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
2597 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
2598 }
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
2599 #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
2600 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
2601 choose_minibuf_frame ();
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2602 message_with_string ("%s(y or n) ", xprompt, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2603
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2604 if (minibuffer_auto_raise)
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2605 {
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2606 Lisp_Object mini_frame;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2607
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2608 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2609
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2610 Fraise_frame (mini_frame);
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2611 }
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2612
23057
2dbf1ec20bf7 (Fy_or_n_p): Don't bind input-method-function.
Richard M. Stallman <rms@gnu.org>
parents: 23051
diff changeset
2613 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
2614 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
2615 /* 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
2616 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
2617
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2618 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
2619 def = Flookup_key (map, key, Qt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2620
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2621 if (EQ (def, intern ("skip")))
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2622 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2623 answer = 0;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2624 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2625 }
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2626 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
2627 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2628 answer = 1;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2629 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2630 }
2311
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2631 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
2632 {
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2633 Frecenter (Qnil);
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2634 xprompt = prompt;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2635 continue;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2636 }
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2637 else if (EQ (def, intern ("quit")))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2638 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
2639 /* 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
2640 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
2641 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
2642 Vquit_flag = Qt;
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2643
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2644 QUIT;
1194
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
2645
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
2646 /* 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
2647 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
2648 Vquit_flag = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2649
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2650 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2651 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2652 if (EQ (xprompt, prompt))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2653 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2654 args[0] = build_string ("Please answer y or n. ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2655 args[1] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2656 xprompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2657 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2658 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2659 UNGCPRO;
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
2660
2525
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
2661 if (! noninteractive)
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
2662 {
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
2663 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
2664 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
2665 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
2666 }
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
2667
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2668 unbind_to (count, Qnil);
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2669 return answer ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2670 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2671
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2672 /* 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
2673 to redefined it.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2674
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2675 Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2676
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2677 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2678 do_yes_or_no_p (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2679 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2680 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2681 return call1 (intern ("yes-or-no-p"), prompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2682 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2683
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2684 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2685
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2686 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
759
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2687 "Ask user a yes-or-no question. Return t if answer is yes.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2688 Takes one argument, which is the string to display to ask the question.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2689 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2690 The user must confirm the answer with RET,\n\
24280
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2691 and can edit it until it has been confirmed.\n\
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2692 \n\
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2693 Under a windowing system a dialog box will be used if `last-nonmenu-event'\n\
40703a998d73 (Fyes_or_no_p, Fy_or_n_p): Doc fix.
Dave Love <fx@gnu.org>
parents: 24275
diff changeset
2694 is nil.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2695 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2696 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2697 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2698 register Lisp_Object ans;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2699 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2700 struct gcpro gcpro1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2701
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2702 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2703
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
2704 #ifdef HAVE_MENUS
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2705 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
2706 && 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
2707 && 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
2708 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2709 Lisp_Object pane, menu, obj;
7815
5d167db8ce8a (Fy_or_n_p, Fyes_or_no_p) [HAVE_X_MENU]: Redisplay before popping up a menu.
Karl Heuer <kwzh@gnu.org>
parents: 7790
diff changeset
2710 redisplay_preserve_echo_area ();
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
2711 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
2712 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
2713 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
2714 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
2715 menu = Fcons (prompt, pane);
6344
4ef6b636dc99 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 6303
diff changeset
2716 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
2717 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
2718 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
2719 }
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
2720 #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
2721
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2722 args[0] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2723 args[1] = build_string ("(yes or no) ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2724 prompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2725
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2726 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
2727
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2728 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2729 {
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
2730 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
2731 Qyes_or_no_p_history, Qnil,
6d3cc8864678 (Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents: 19383
diff changeset
2732 Qnil));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2733 if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2734 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2735 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2736 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2737 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2738 if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2739 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2740 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2741 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2742 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2743
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2744 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2745 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2746 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
2747 Fsleep_for (make_number (2), Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2748 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2749 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2750
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2751 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2752 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2753 Each of the three load averages is multiplied by 100,\n\
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2754 then converted to integer.\n\
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2755 When USE-FLOATS is non-nil, floats will be used instead of integers.\n\
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2756 These floats are not multiplied by 100.\n\n\
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2757 If the 5-minute or 15-minute load averages are not available, return a\n\
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2758 shortened list, containing only those averages which are available.")
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2759 (use_floats)
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2760 Lisp_Object use_floats;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2761 {
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2762 double load_ave[3];
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2763 int loads = getloadavg (load_ave, 3);
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2764 Lisp_Object ret = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2765
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2766 if (loads < 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2767 error ("load-average not implemented for this operating system");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2768
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2769 while (loads-- > 0)
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2770 {
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2771 Lisp_Object load = (NILP (use_floats) ?
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2772 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
2773 : make_float (load_ave[loads]));
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2774 ret = Fcons (load, ret);
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2775 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2776
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2777 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2778 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2779
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2780 Lisp_Object Vfeatures;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2781
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2782 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2783 "Returns t if FEATURE is present in this Emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2784 Use this to conditionalize execution of lisp code based on the presence or\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2785 absence of emacs or environment extensions.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2786 Use `provide' to declare that a feature is available.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2787 This function looks at the value of the variable `features'.")
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2788 (feature)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2789 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2790 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2791 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2792 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2793 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2794 return (NILP (tem)) ? Qnil : Qt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2795 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2796
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2797 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2798 "Announce that FEATURE is a feature of the current Emacs.")
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2799 (feature)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2800 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2801 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2802 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2803 CHECK_SYMBOL (feature, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2804 if (!NILP (Vautoload_queue))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2805 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2806 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2807 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2808 Vfeatures = Fcons (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2809 LOADHIST_ATTACH (Fcons (Qprovide, feature));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2810 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2811 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2812
23733
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2813 DEFUN ("require", Frequire, Srequire, 1, 3, 0,
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2814 "If feature FEATURE is not loaded, load it from FILENAME.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2815 If FEATURE is not a member of the list `features', then the feature\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2816 is not loaded; so load the file FILENAME.\n\
21577
027075cb9a49 (Frequire): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21523
diff changeset
2817 If FILENAME is omitted, the printname of FEATURE is used as the file name,\n\
23733
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2818 but in this case `load' insists on adding the suffix `.el' or `.elc'.\n\
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2819 If the optional third argument NOERROR is non-nil,\n\
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2820 then return nil if the file is not found.\n\
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2821 Normally the return value is FEATURE.")
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2822 (feature, file_name, noerror)
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2823 Lisp_Object feature, file_name, noerror;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2824 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2825 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2826 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2827 tem = Fmemq (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2828 LOADHIST_ATTACH (Fcons (Qrequire, feature));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2829 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2830 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2831 int count = specpdl_ptr - specpdl;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2832
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2833 /* Value saved here is to be restored into Vautoload_queue */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2834 record_unwind_protect (un_autoload, Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2835 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2836
23733
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2837 tem = Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2838 noerror, Qt, Qnil, (NILP (file_name) ? Qt : Qnil));
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2839 /* If load failed entirely, return nil. */
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2840 if (NILP (tem))
24016
43344f47a865 (Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents: 23927
diff changeset
2841 return unbind_to (count, Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2842
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2843 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2844 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2845 error ("Required feature %s was not provided",
19223
475cf041a683 (Frequire): Don't insist on a suffix
Richard M. Stallman <rms@gnu.org>
parents: 19117
diff changeset
2846 XSYMBOL (feature)->name->data);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2847
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2848 /* Once loading finishes, don't undo it. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2849 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2850 feature = unbind_to (count, feature);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2851 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2852 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2853 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2854
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2855 /* Primitives for work of the "widget" library.
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2856 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
2857 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
2858 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
2859 bottleneck of Widget operation. Here is their translation to C,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2860 for the sole reason of efficiency. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2861
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2862 DEFUN ("widget-plist-member", Fwidget_plist_member, Swidget_plist_member, 2, 2, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2863 "Return non-nil if PLIST has the property PROP.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2864 PLIST is a property list, which is a list of the form\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2865 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2866 Unlike `plist-get', this allows you to distinguish between a missing\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2867 property and a property with the value nil.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2868 The value is actually the tail of PLIST whose car is PROP.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2869 (plist, prop)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2870 Lisp_Object plist, prop;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2871 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2872 while (CONSP (plist) && !EQ (XCAR (plist), prop))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2873 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2874 QUIT;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2875 plist = XCDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2876 plist = CDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2877 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2878 return plist;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2879 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2880
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2881 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2882 "In WIDGET, set PROPERTY to VALUE.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2883 The value can later be retrieved with `widget-get'.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2884 (widget, property, value)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2885 Lisp_Object widget, property, value;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2886 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2887 CHECK_CONS (widget, 1);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2888 XCDR (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
2889 return value;
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2890 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2891
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2892 DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2893 "In WIDGET, get the value of PROPERTY.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2894 The value could either be specified when the widget was created, or\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2895 later with `widget-put'.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2896 (widget, property)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2897 Lisp_Object widget, property;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2898 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2899 Lisp_Object tmp;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2900
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2901 while (1)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2902 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2903 if (NILP (widget))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2904 return Qnil;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2905 CHECK_CONS (widget, 1);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2906 tmp = Fwidget_plist_member (XCDR (widget), property);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2907 if (CONSP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2908 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2909 tmp = XCDR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2910 return CAR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2911 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2912 tmp = XCAR (widget);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2913 if (NILP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2914 return Qnil;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2915 widget = Fget (tmp, Qwidget_type);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2916 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2917 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2918
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2919 DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2920 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2921 ARGS are passed as extra arguments to the function.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2922 (nargs, args)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2923 int nargs;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2924 Lisp_Object *args;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2925 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2926 /* This function can GC. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2927 Lisp_Object newargs[3];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2928 struct gcpro gcpro1, gcpro2;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2929 Lisp_Object result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2930
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2931 newargs[0] = Fwidget_get (args[0], args[1]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2932 newargs[1] = args[0];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2933 newargs[2] = Flist (nargs - 2, args + 2);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2934 GCPRO2 (newargs[0], newargs[2]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2935 result = Fapply (3, newargs);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2936 UNGCPRO;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2937 return result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2938 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2939
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2940 /* base64 encode/decode functions.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2941 Based on code from GNU recode. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2942
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2943 #define MIME_LINE_LENGTH 76
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2944
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2945 #define IS_ASCII(Character) \
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2946 ((Character) < 128)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2947 #define IS_BASE64(Character) \
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2948 (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
2949 #define IS_BASE64_IGNORABLE(Character) \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2950 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2951 || (Character) == '\f' || (Character) == '\r')
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2952
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2953 /* 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
2954 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
2955 process. */
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2956 #define READ_QUADRUPLET_BYTE(retval) \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2957 do \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2958 { \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2959 if (i == length) \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2960 return (retval); \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2961 c = from[i++]; \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2962 } \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2963 while (IS_BASE64_IGNORABLE (c))
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2964
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
2965 /* 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
2966 their stack. */
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
2967 #define MAX_ALLOCA 16*1024
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
2968
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2969 /* 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
2970 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
2971 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2972 '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
2973 '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
2974 '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
2975 '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
2976 '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
2977 '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
2978 '8', '9', '+', '/' /* 60-63 */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2979 };
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2980
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2981 /* 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
2982 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
2983 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2984 -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
2985 -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
2986 -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
2987 -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
2988 -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
2989 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
2990 -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
2991 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
2992 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
2993 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
2994 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
2995 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
2996 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
2997 };
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2998
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2999 /* 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
3000 get transformed into four base64 characters.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3001
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3002 .--------. .--------. .--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3003 |aaaaaabb| |bbbbcccc| |ccdddddd|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3004 `--------' `--------' `--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3005 6 2 4 4 2 6
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3006 .--------+--------+--------+--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3007 |00aaaaaa|00bbbbbb|00cccccc|00dddddd|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3008 `--------+--------+--------+--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3009
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3010 .--------+--------+--------+--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3011 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3012 `--------+--------+--------+--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3013
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3014 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
3015 base64 characters. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3016
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3017
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3018 static int base64_encode_1 P_ ((const char *, char *, int, int));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3019 static int base64_decode_1 P_ ((const char *, char *, int));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3020
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3021 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
3022 2, 3, "r",
23557
1a67e5327a04 (Fbase64_decode_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23556
diff changeset
3023 "Base64-encode the region between BEG and END.\n\
23556
82fdd7048bcf (Fbase64_decode_region, Fbase64_encode_region): Fix
Dave Love <fx@gnu.org>
parents: 23536
diff changeset
3024 Return the length of the encoded text.\n\
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3025 Optional third argument NO-LINE-BREAK means do not break long lines\n\
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3026 into shorter lines.")
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3027 (beg, end, no_line_break)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3028 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
3029 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3030 char *encoded;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3031 int allength, length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3032 int ibeg, iend, encoded_length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3033 int old_pos = PT;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3034
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3035 validate_region (&beg, &end);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3036
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3037 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3038 iend = CHAR_TO_BYTE (XFASTINT (end));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3039 move_gap_both (XFASTINT (beg), ibeg);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3040
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3041 /* 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
3042 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
3043 characters, and then we round up. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3044 length = iend - ibeg;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3045 allength = length + length/3 + 1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3046 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
3047
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3048 if (allength <= MAX_ALLOCA)
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3049 encoded = (char *) alloca (allength);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3050 else
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3051 encoded = (char *) xmalloc (allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3052 encoded_length = base64_encode_1 (BYTE_POS_ADDR (ibeg), encoded, length,
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3053 NILP (no_line_break));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3054 if (encoded_length > allength)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3055 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3056
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3057 /* 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
3058 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
3059 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
3060 insert (encoded, encoded_length);
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3061 if (allength > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3062 xfree (encoded);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3063 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
3064
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3065 /* 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
3066 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
3067 if (old_pos >= XFASTINT (end))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3068 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
3069 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
3070 old_pos = XFASTINT (beg);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3071 SET_PT (old_pos);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3072
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3073 /* 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
3074 return make_number (encoded_length);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3075 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3076
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3077 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
3078 1, 2, 0,
c56b72e5f29d (Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents: 24280
diff changeset
3079 "Base64-encode STRING and return the result.\n\
c56b72e5f29d (Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents: 24280
diff changeset
3080 Optional second argument NO-LINE-BREAK means do not break long lines\n\
c56b72e5f29d (Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents: 24280
diff changeset
3081 into shorter lines.")
c56b72e5f29d (Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents: 24280
diff changeset
3082 (string, no_line_break)
24377
f881dd22ec7d (Fbase64_encode_string): Fix last change.
Andreas Schwab <schwab@suse.de>
parents: 24334
diff changeset
3083 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
3084 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3085 int allength, length, encoded_length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3086 char *encoded;
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3087 Lisp_Object encoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3088
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3089 CHECK_STRING (string, 1);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3090
24437
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3091 /* 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
3092 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
3093 characters, and then we round up. */
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3094 length = STRING_BYTES (XSTRING (string));
24437
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3095 allength = length + length/3 + 1;
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3096 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
3097
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3098 /* 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
3099 if (allength <= MAX_ALLOCA)
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3100 encoded = (char *) alloca (allength);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3101 else
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3102 encoded = (char *) xmalloc (allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3103
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3104 encoded_length = base64_encode_1 (XSTRING (string)->data,
24334
c56b72e5f29d (Fbase64_encode_string): New optional argument `NO_LINE_BREAK'.
Kenichi Handa <handa@m17n.org>
parents: 24280
diff changeset
3105 encoded, length, NILP (no_line_break));
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3106 if (encoded_length > allength)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3107 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3108
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3109 encoded_string = make_unibyte_string (encoded, encoded_length);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3110 if (allength > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3111 xfree (encoded);
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3112
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3113 return encoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3114 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3115
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3116 static int
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3117 base64_encode_1 (from, to, length, line_break)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3118 const char *from;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3119 char *to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3120 int length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3121 int line_break;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3122 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3123 int counter = 0, i = 0;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3124 char *e = to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3125 unsigned char c;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3126 unsigned int value;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3127
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3128 while (i < length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3129 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3130 c = from[i++];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3131
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3132 /* Wrap line every 76 characters. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3133
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3134 if (line_break)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3135 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3136 if (counter < MIME_LINE_LENGTH / 4)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3137 counter++;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3138 else
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3139 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3140 *e++ = '\n';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3141 counter = 1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3142 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3143 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3144
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3145 /* Process first byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3146
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3147 *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
3148 value = (0x03 & c) << 4;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3149
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3150 /* Process second byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3151
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3152 if (i == length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3153 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3154 *e++ = base64_value_to_char[value];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3155 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3156 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3157 break;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3158 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3159
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3160 c = from[i++];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3161
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3162 *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
3163 value = (0x0f & c) << 2;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3164
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3165 /* Process third byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3166
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3167 if (i == length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3168 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3169 *e++ = base64_value_to_char[value];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3170 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3171 break;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3172 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3173
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3174 c = from[i++];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3175
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3176 *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
3177 *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
3178 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3179
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3180 return e - to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3181 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3182
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3183
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3184 DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3185 2, 2, "r",
23557
1a67e5327a04 (Fbase64_decode_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23556
diff changeset
3186 "Base64-decode the region between BEG and END.\n\
23556
82fdd7048bcf (Fbase64_decode_region, Fbase64_encode_region): Fix
Dave Love <fx@gnu.org>
parents: 23536
diff changeset
3187 Return the length of the decoded text.\n\
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3188 If the region can't be decoded, return nil and don't modify the buffer.")
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3189 (beg, end)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3190 Lisp_Object beg, end;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3191 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3192 int ibeg, iend, length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3193 char *decoded;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3194 int old_pos = PT;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3195 int decoded_length;
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3196 int inserted_chars;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3197
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3198 validate_region (&beg, &end);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3199
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3200 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3201 iend = CHAR_TO_BYTE (XFASTINT (end));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3202
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3203 length = iend - ibeg;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3204 /* 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
3205 if (length <= MAX_ALLOCA)
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3206 decoded = (char *) alloca (length);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3207 else
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3208 decoded = (char *) xmalloc (length);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3209
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3210 move_gap_both (XFASTINT (beg), ibeg);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3211 decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3212 if (decoded_length > length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3213 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3214
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3215 if (decoded_length < 0)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3216 {
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3217 /* The decoding wasn't possible. */
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3218 if (length > MAX_ALLOCA)
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3219 xfree (decoded);
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3220 return Qnil;
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3221 }
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3222
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3223 /* 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
3224 and delete the old. (Insert first in order to preserve markers.) */
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3225 /* We insert two spaces, then insert the decoded text in between
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3226 them, at last, delete those extra two spaces. This is to avoid
23595
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3227 byte combining while inserting. */
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3228 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg);
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3229 insert_1_both (" ", 2, 2, 0, 1, 0);
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3230 TEMP_SET_PT_BOTH (XFASTINT (beg) + 1, ibeg + 1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3231 insert (decoded, decoded_length);
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3232 inserted_chars = PT - (XFASTINT (beg) + 1);
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3233 if (length > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3234 xfree (decoded);
23595
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3235 /* At first delete the original text. This never cause byte
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3236 combining. */
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3237 del_range_both (PT + 1, PT_BYTE + 1, XFASTINT (end) + inserted_chars + 2,
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3238 iend + decoded_length + 2, 1);
23595
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3239 /* Next delete the extra spaces. This will cause byte combining
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3240 error. */
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3241 del_range_both (PT, PT_BYTE, PT + 1, PT_BYTE + 1, 0);
e8bf0c9f869d (Fbase64_decode_region): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23579
diff changeset
3242 del_range_both (XFASTINT (beg), ibeg, XFASTINT (beg) + 1, ibeg + 1, 0);
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3243 inserted_chars = PT - XFASTINT (beg);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3244
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3245 /* 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
3246 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
3247 if (old_pos >= XFASTINT (end))
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3248 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
3249 else if (old_pos > XFASTINT (beg))
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3250 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
3251 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
3252
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3253 return make_number (inserted_chars);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3254 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3255
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3256 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
3257 1, 1, 0,
23557
1a67e5327a04 (Fbase64_decode_string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23556
diff changeset
3258 "Base64-decode STRING and return the result.")
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3259 (string)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3260 Lisp_Object string;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3261 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3262 char *decoded;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3263 int length, decoded_length;
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3264 Lisp_Object decoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3265
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3266 CHECK_STRING (string, 1);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3267
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3268 length = STRING_BYTES (XSTRING (string));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3269 /* 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
3270 if (length <= MAX_ALLOCA)
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3271 decoded = (char *) alloca (length);
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3272 else
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3273 decoded = (char *) xmalloc (length);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3274
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3275 decoded_length = base64_decode_1 (XSTRING (string)->data, decoded, length);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3276 if (decoded_length > length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3277 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3278
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3279 if (decoded_length < 0)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3280 /* The decoding wasn't possible. */
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3281 decoded_string = Qnil;
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3282 else
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3283 decoded_string = make_string (decoded, decoded_length);
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3284
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3285 if (length > MAX_ALLOCA)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3286 xfree (decoded);
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3287
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3288 return decoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3289 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3290
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3291 static int
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3292 base64_decode_1 (from, to, length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3293 const char *from;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3294 char *to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3295 int length;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3296 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3297 int i = 0;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3298 char *e = to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3299 unsigned char c;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3300 unsigned long value;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3301
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3302 while (1)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3303 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3304 /* Process first byte of a quadruplet. */
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3305
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3306 READ_QUADRUPLET_BYTE (e-to);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3307
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3308 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3309 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3310 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
3311
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3312 /* Process second byte of a quadruplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3313
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3314 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3315
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3316 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3317 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3318 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
3319
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3320 *e++ = (unsigned char) (value >> 16);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3321
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3322 /* Process third byte of a quadruplet. */
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3323
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3324 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3325
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3326 if (c == '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3327 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3328 READ_QUADRUPLET_BYTE (-1);
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3329
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3330 if (c != '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3331 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3332 continue;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3333 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3334
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3335 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3336 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3337 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
3338
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3339 *e++ = (unsigned char) (0xff & value >> 8);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3340
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3341 /* Process fourth byte of a quadruplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3342
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3343 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3344
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3345 if (c == '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3346 continue;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3347
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3348 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3349 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3350 value |= base64_char_to_value[c];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3351
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3352 *e++ = (unsigned char) (0xff & value);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3353 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3354 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3355
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3356
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3357
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3358 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3359 ***** *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3360 ***** Hash Tables *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3361 ***** *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3362 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3363
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3364 /* Implemented by gerd@gnu.org. This hash table implementation was
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3365 inspired by CMUCL hash tables. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3366
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3367 /* Ideas:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3368
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3369 1. For small tables, association lists are probably faster than
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3370 hash tables because they have lower overhead.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3371
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3372 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
3373 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
3374 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
3375 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
3376 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
3377
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3378
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3379 /* Return the contents of vector V at index IDX. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3380
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3381 #define AREF(V, IDX) XVECTOR (V)->contents[IDX]
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3382
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3383 /* Value is the key part of entry IDX in hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3384
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3385 #define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3386
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3387 /* Value is the value part of entry IDX in hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3388
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3389 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3390
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3391 /* Value is the index of the next entry following the one at IDX
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3392 in hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3393
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3394 #define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3395
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3396 /* Value is the hash code computed for entry IDX in hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3397
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3398 #define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3399
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3400 /* Value is the index of the element in hash table H that is the
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3401 start of the collision list at index IDX in the index vector of H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3402
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3403 #define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3404
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3405 /* Value is the size of hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3406
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3407 #define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3408
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3409 /* 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
3410
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3411 Lisp_Object Vweak_hash_tables;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3412
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3413 /* Various symbols. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3414
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3415 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue;
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
3416 Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3417 Lisp_Object Qhash_table_test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3418
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3419 /* Function prototypes. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3420
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3421 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
3422 static int next_almost_prime P_ ((int));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3423 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
3424 static Lisp_Object larger_vector P_ ((Lisp_Object, int, Lisp_Object));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3425 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
3426 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
3427 Lisp_Object, unsigned));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3428 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
3429 Lisp_Object, unsigned));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3430 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
3431 unsigned, Lisp_Object, unsigned));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3432 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
3433 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
3434 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
3435 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3436 Lisp_Object));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3437 static unsigned sxhash_string P_ ((unsigned char *, int));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3438 static unsigned sxhash_list P_ ((Lisp_Object, int));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3439 static unsigned sxhash_vector P_ ((Lisp_Object, int));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3440 static unsigned sxhash_bool_vector P_ ((Lisp_Object));
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3441 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
3442
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3443
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3444
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3445 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3446 Utilities
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3447 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3448
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3449 /* 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
3450 Lisp_Hash_Table. Otherwise, signal an error. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3451
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3452 static struct Lisp_Hash_Table *
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3453 check_hash_table (obj)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3454 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3455 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3456 CHECK_HASH_TABLE (obj, 0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3457 return XHASH_TABLE (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3458 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3459
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3460
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3461 /* 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
3462 number. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3463
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3464 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3465 next_almost_prime (n)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3466 int n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3467 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3468 if (n % 2 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3469 n += 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3470 if (n % 3 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3471 n += 2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3472 if (n % 7 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3473 n += 4;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3474 return n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3475 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3476
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3477
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3478 /* 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
3479 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
3480 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
3481 -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
3482 a DEFUN parameter list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3483
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3484 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3485 get_key_arg (key, nargs, args, used)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3486 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3487 int nargs;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3488 Lisp_Object *args;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3489 char *used;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3490 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3491 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3492
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3493 for (i = 0; i < nargs - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3494 if (!used[i] && EQ (args[i], key))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3495 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3496
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3497 if (i >= nargs - 1)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3498 i = -1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3499 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3500 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3501 used[i++] = 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3502 used[i] = 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3503 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3504
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3505 return i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3506 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3507
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3508
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3509 /* 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
3510 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
3511 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
3512
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3513 static Lisp_Object
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3514 larger_vector (vec, new_size, init)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3515 Lisp_Object vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3516 int new_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3517 Lisp_Object init;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3518 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3519 struct Lisp_Vector *v;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3520 int i, old_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3521
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3522 xassert (VECTORP (vec));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3523 old_size = XVECTOR (vec)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3524 xassert (new_size >= old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3525
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3526 v = allocate_vectorlike (new_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3527 v->size = new_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3528 bcopy (XVECTOR (vec)->contents, v->contents,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3529 old_size * sizeof *v->contents);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3530 for (i = old_size; i < new_size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3531 v->contents[i] = init;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3532 XSETVECTOR (vec, v);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3533 return vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3534 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3535
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3536
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3537 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3538 Low-level Functions
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3539 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3540
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3541 /* 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
3542 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
3543 KEY2 are the same. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3544
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3545 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3546 cmpfn_eql (h, key1, hash1, key2, hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3547 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3548 Lisp_Object key1, key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3549 unsigned hash1, hash2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3550 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3551 return (FLOATP (key1)
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3552 && FLOATP (key2)
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
3553 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3554 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3555
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3556
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3557 /* 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
3558 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
3559 KEY2 are the same. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3560
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3561 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3562 cmpfn_equal (h, key1, hash1, key2, hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3563 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3564 Lisp_Object key1, key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3565 unsigned hash1, hash2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3566 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3567 return hash1 == hash2 && !NILP (Fequal (key1, key2));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3568 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3569
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3570
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3571 /* 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
3572 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
3573 if KEY1 and KEY2 are the same. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3574
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3575 static int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3576 cmpfn_user_defined (h, key1, hash1, key2, hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3577 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3578 Lisp_Object key1, key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3579 unsigned hash1, hash2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3580 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3581 if (hash1 == hash2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3582 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3583 Lisp_Object args[3];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3584
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3585 args[0] = h->user_cmp_function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3586 args[1] = key1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3587 args[2] = key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3588 return !NILP (Ffuncall (3, args));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3589 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3590 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3591 return 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3592 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3593
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3594
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3595 /* 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
3596 `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
3597 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3598
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3599 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3600 hashfn_eq (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3601 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3602 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3603 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3604 /* Lisp strings can change their address. Don't try to compute a
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3605 hash code for a string from its address. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3606 if (STRINGP (key))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3607 return sxhash_string (XSTRING (key)->data, XSTRING (key)->size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3608 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3609 return XUINT (key) ^ XGCTYPE (key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3610 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3611
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3612
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3613 /* 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
3614 `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
3615 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3616
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3617 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3618 hashfn_eql (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3619 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3620 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3621 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3622 /* Lisp strings can change their address. Don't try to compute a
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3623 hash code for a string from its address. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3624 if (STRINGP (key))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3625 return sxhash_string (XSTRING (key)->data, XSTRING (key)->size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3626 else if (FLOATP (key))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3627 return sxhash (key, 0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3628 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3629 return XUINT (key) ^ XGCTYPE (key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3630 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3631
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3632
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3633 /* 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
3634 `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
3635 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3636
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3637 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3638 hashfn_equal (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3639 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3640 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3641 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3642 return sxhash (key, 0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3643 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3644
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3645
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3646 /* 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
3647 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
3648 guaranteed to fit in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3649
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3650 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3651 hashfn_user_defined (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3652 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3653 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3654 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3655 Lisp_Object args[2], hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3656
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3657 args[0] = h->user_hash_function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3658 args[1] = key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3659 hash = Ffuncall (2, args);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3660 if (!INTEGERP (hash))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3661 Fsignal (Qerror,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3662 list2 (build_string ("Illegal hash code returned from \
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3663 user-supplied hash function"),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3664 hash));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3665 return XUINT (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3666 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3667
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3668
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3669 /* Create and initialize a new hash table.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3670
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3671 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
3672 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
3673 `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
3674 test and hash functions USER_TEST and USER_HASH.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3675
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3676 Give the table initial capacity SIZE, SIZE > 0, an integer.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3677
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3678 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
3679 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
3680 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
3681 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
3682 REHASH_SIZE.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3683
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3684 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
3685 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
3686 (table size) is >= REHASH_THRESHOLD.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3687
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3688 WEAK specifies the weakness of the table. If non-nil, it must be
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3689 one of the symbols `key', `value' or t. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3690
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3691 Lisp_Object
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3692 make_hash_table (test, size, rehash_size, rehash_threshold, weak,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3693 user_test, user_hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3694 Lisp_Object test, size, rehash_size, rehash_threshold, weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3695 Lisp_Object user_test, user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3696 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3697 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3698 struct Lisp_Vector *v;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3699 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3700 int index_size, i, len, sz;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3701
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3702 /* Preconditions. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3703 xassert (SYMBOLP (test));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3704 xassert (INTEGERP (size) && XINT (size) > 0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3705 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3706 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3707 xassert (FLOATP (rehash_threshold)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3708 && XFLOATINT (rehash_threshold) > 0
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3709 && XFLOATINT (rehash_threshold) <= 1.0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3710
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3711 /* Allocate a vector, and initialize it. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3712 len = VECSIZE (struct Lisp_Hash_Table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3713 v = allocate_vectorlike (len);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3714 v->size = len;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3715 for (i = 0; i < len; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3716 v->contents[i] = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3717
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3718 /* Initialize hash table slots. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3719 sz = XFASTINT (size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3720 h = (struct Lisp_Hash_Table *) v;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3721
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3722 h->test = test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3723 if (EQ (test, Qeql))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3724 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3725 h->cmpfn = cmpfn_eql;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3726 h->hashfn = hashfn_eql;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3727 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3728 else if (EQ (test, Qeq))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3729 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3730 h->cmpfn = NULL;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3731 h->hashfn = hashfn_eq;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3732 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3733 else if (EQ (test, Qequal))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3734 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3735 h->cmpfn = cmpfn_equal;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3736 h->hashfn = hashfn_equal;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3737 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3738 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3739 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3740 h->user_cmp_function = user_test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3741 h->user_hash_function = user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3742 h->cmpfn = cmpfn_user_defined;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3743 h->hashfn = hashfn_user_defined;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3744 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3745
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3746 h->weak = weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3747 h->rehash_threshold = rehash_threshold;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3748 h->rehash_size = rehash_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3749 h->count = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3750 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
3751 h->hash = Fmake_vector (size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3752 h->next = Fmake_vector (size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3753 index_size = next_almost_prime (sz / XFLOATINT (rehash_threshold));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3754 h->index = Fmake_vector (make_number (index_size), Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3755
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3756 /* Set up the free list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3757 for (i = 0; i < sz - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3758 HASH_NEXT (h, i) = make_number (i + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3759 h->next_free = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3760
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3761 XSET_HASH_TABLE (table, h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3762 xassert (HASH_TABLE_P (table));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3763 xassert (XHASH_TABLE (table) == h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3764
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3765 /* 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
3766 if (NILP (h->weak))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3767 h->next_weak = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3768 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3769 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3770 h->next_weak = Vweak_hash_tables;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3771 Vweak_hash_tables = table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3772 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3773
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3774 return table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3775 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3776
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3777
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3778 /* 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
3779 only the table itself is. */
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3780
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3781 Lisp_Object
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3782 copy_hash_table (h1)
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3783 struct Lisp_Hash_Table *h1;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3784 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3785 Lisp_Object table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3786 struct Lisp_Hash_Table *h2;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3787 struct Lisp_Vector *v, *next;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3788 int len;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3789
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3790 len = VECSIZE (struct Lisp_Hash_Table);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3791 v = allocate_vectorlike (len);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3792 h2 = (struct Lisp_Hash_Table *) v;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3793 next = h2->vec_next;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3794 bcopy (h1, h2, sizeof *h2);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3795 h2->vec_next = next;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3796 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
3797 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
3798 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
3799 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
3800 XSET_HASH_TABLE (table, h2);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3801
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3802 /* 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
3803 if (!NILP (h2->weak))
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3804 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3805 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
3806 Vweak_hash_tables = table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3807 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3808
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3809 return table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3810 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3811
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3812
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3813 /* 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
3814 because it's already too large, throw an error. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3815
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3816 static INLINE void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3817 maybe_resize_hash_table (h)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3818 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3819 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3820 if (NILP (h->next_free))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3821 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3822 int old_size = HASH_TABLE_SIZE (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3823 int i, new_size, index_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3824
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3825 if (INTEGERP (h->rehash_size))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3826 new_size = old_size + XFASTINT (h->rehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3827 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3828 new_size = old_size * XFLOATINT (h->rehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3829 index_size = next_almost_prime (new_size
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3830 / XFLOATINT (h->rehash_threshold));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3831 if (max (index_size, 2 * new_size) & ~VALMASK)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3832 error ("Hash table too large to resize");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3833
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3834 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
3835 h->next = larger_vector (h->next, new_size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3836 h->hash = larger_vector (h->hash, new_size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3837 h->index = Fmake_vector (make_number (index_size), Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3838
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3839 /* 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
3840 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
3841 maphash faster. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3842 for (i = old_size; i < new_size - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3843 HASH_NEXT (h, i) = make_number (i + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3844
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3845 if (!NILP (h->next_free))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3846 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3847 Lisp_Object last, next;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3848
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3849 last = h->next_free;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3850 while (next = HASH_NEXT (h, XFASTINT (last)),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3851 !NILP (next))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3852 last = next;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3853
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3854 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3855 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3856 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3857 XSETFASTINT (h->next_free, old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3858
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3859 /* Rehash. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3860 for (i = 0; i < old_size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3861 if (!NILP (HASH_HASH (h, i)))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3862 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3863 unsigned hash_code = XUINT (HASH_HASH (h, i));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3864 int start_of_bucket = hash_code % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3865 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3866 HASH_INDEX (h, start_of_bucket) = make_number (i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3867 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3868 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3869 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3870
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3871
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3872 /* 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
3873 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
3874 matching KEY, or -1 if not found. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3875
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3876 int
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3877 hash_lookup (h, key, hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3878 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3879 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3880 unsigned *hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3881 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3882 unsigned hash_code;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3883 int start_of_bucket;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3884 Lisp_Object idx;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3885
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3886 hash_code = h->hashfn (h, key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3887 if (hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3888 *hash = hash_code;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3889
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3890 start_of_bucket = hash_code % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3891 idx = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3892
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3893 while (!NILP (idx))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3894 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3895 int i = XFASTINT (idx);
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3896 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
3897 || (h->cmpfn
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3898 && h->cmpfn (h, key, hash_code,
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3899 HASH_KEY (h, i), HASH_HASH (h, i))))
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3900 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3901 idx = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3902 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3903
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3904 return NILP (idx) ? -1 : XFASTINT (idx);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3905 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3906
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3907
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3908 /* 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
3909 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
3910 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
3911
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
3912 int
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3913 hash_put (h, key, value, hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3914 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3915 Lisp_Object key, value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3916 unsigned hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3917 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3918 int start_of_bucket, i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3919
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3920 xassert ((hash & ~VALMASK) == 0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3921
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3922 /* Increment count after resizing because resizing may fail. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3923 maybe_resize_hash_table (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3924 h->count = make_number (XFASTINT (h->count) + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3925
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3926 /* Store key/value in the key_and_value vector. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3927 i = XFASTINT (h->next_free);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3928 h->next_free = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3929 HASH_KEY (h, i) = key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3930 HASH_VALUE (h, i) = value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3931
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3932 /* Remember its hash code. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3933 HASH_HASH (h, i) = make_number (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3934
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3935 /* Add new entry to its collision chain. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3936 start_of_bucket = hash % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3937 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3938 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
3939 return i;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3940 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3941
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3942
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3943 /* 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
3944
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3945 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3946 hash_remove (h, key)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3947 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3948 Lisp_Object key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3949 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3950 unsigned hash_code;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3951 int start_of_bucket;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3952 Lisp_Object idx, prev;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3953
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3954 hash_code = h->hashfn (h, key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3955 start_of_bucket = hash_code % XVECTOR (h->index)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3956 idx = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3957 prev = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3958
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3959 while (!NILP (idx))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3960 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3961 int i = XFASTINT (idx);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3962
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3963 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
3964 || (h->cmpfn
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3965 && h->cmpfn (h, key, hash_code,
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3966 HASH_KEY (h, i), HASH_HASH (h, i))))
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3967 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3968 /* Take entry out of collision chain. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3969 if (NILP (prev))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3970 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3971 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3972 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3973
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3974 /* 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
3975 the free list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3976 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
3977 HASH_NEXT (h, i) = h->next_free;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3978 h->next_free = make_number (i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3979 h->count = make_number (XFASTINT (h->count) - 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3980 xassert (XINT (h->count) >= 0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3981 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3982 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3983 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3984 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3985 prev = idx;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3986 idx = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3987 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3988 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3989 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3990
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3991
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3992 /* Clear hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3993
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3994 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3995 hash_clear (h)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3996 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3997 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3998 if (XFASTINT (h->count) > 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3999 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4000 int i, size = HASH_TABLE_SIZE (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4001
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4002 for (i = 0; i < size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4003 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4004 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
4005 HASH_KEY (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4006 HASH_VALUE (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4007 HASH_HASH (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4008 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4009
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4010 for (i = 0; i < XVECTOR (h->index)->size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4011 XVECTOR (h->index)->contents[i] = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4012
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4013 h->next_free = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4014 h->count = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4015 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4016 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4017
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4018
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4019
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4020 /************************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4021 Weak Hash Tables
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4022 ************************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4023
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4024 /* 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
4025 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
4026 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
4027 non-zero if anything was marked. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4028
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4029 static int
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4030 sweep_weak_table (h, remove_entries_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4031 struct Lisp_Hash_Table *h;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4032 int remove_entries_p;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4033 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4034 int bucket, n, marked;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4035
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4036 n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4037 marked = 0;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4038
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4039 for (bucket = 0; bucket < n; ++bucket)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4040 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4041 Lisp_Object idx, prev;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4042
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4043 /* Follow collision chain, removing entries that
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4044 don't survive this garbage collection. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4045 idx = HASH_INDEX (h, bucket);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4046 prev = Qnil;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4047 while (!GC_NILP (idx))
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4048 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4049 int remove_p;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4050 int i = XFASTINT (idx);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4051 Lisp_Object next;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4052
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4053 if (EQ (h->weak, Qkey))
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4054 remove_p = !survives_gc_p (HASH_KEY (h, i));
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4055 else if (EQ (h->weak, Qvalue))
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4056 remove_p = !survives_gc_p (HASH_VALUE (h, i));
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4057 else if (EQ (h->weak, Qt))
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4058 remove_p = (!survives_gc_p (HASH_KEY (h, i))
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4059 || !survives_gc_p (HASH_VALUE (h, i)));
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4060 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4061 abort ();
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4062
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4063 next = HASH_NEXT (h, i);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4064
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4065 if (remove_entries_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4066 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4067 if (remove_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4068 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4069 /* Take out of collision chain. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4070 if (GC_NILP (prev))
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4071 HASH_INDEX (h, i) = next;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4072 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4073 HASH_NEXT (h, XFASTINT (prev)) = next;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4074
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4075 /* Add to free list. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4076 HASH_NEXT (h, i) = h->next_free;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4077 h->next_free = idx;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4078
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4079 /* Clear key, value, and hash. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4080 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4081 HASH_HASH (h, i) = Qnil;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4082
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4083 h->count = make_number (XFASTINT (h->count) - 1);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4084 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4085 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4086 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4087 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4088 if (!remove_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4089 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4090 /* Make sure key and value survive. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4091 mark_object (&HASH_KEY (h, i));
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4092 mark_object (&HASH_VALUE (h, i));
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4093 marked = 1;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4094 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4095 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4096
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4097 idx = next;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4098 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4099 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4100
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4101 return marked;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4102 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4103
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4104 /* 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
4105 current garbage collection. Remove weak tables that don't survive
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4106 from Vweak_hash_tables. Called from gc_sweep. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4107
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4108 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4109 sweep_weak_hash_tables ()
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4110 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4111 Lisp_Object table;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4112 struct Lisp_Hash_Table *h, *prev;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4113 int marked;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4114
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4115 /* 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
4116 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
4117 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
4118 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
4119 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
4120 one finds that it shouldn't. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4121 do
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4122 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4123 marked = 0;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4124 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
4125 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4126 h = XHASH_TABLE (table);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4127 if (h->size & ARRAY_MARK_FLAG)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4128 marked |= sweep_weak_table (h, 0);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4129 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4130 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4131 while (marked);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4132
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4133 /* Remove tables and entries that aren't used. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4134 prev = NULL;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4135 for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak)
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 prev = h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4138 h = XHASH_TABLE (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4139
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4140 if (h->size & ARRAY_MARK_FLAG)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4141 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4142 if (XFASTINT (h->count) > 0)
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4143 sweep_weak_table (h, 1);
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 else
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 /* Table is not marked, and will thus be freed.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4148 Take it out of the list of weak hash tables. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4149 if (prev)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4150 prev->next_weak = h->next_weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4151 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4152 Vweak_hash_tables = h->next_weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4153 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4154 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4155 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4156
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4157
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4158
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4159 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4160 Hash Code Computation
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4161 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4162
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4163 /* Maximum depth up to which to dive into Lisp structures. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4164
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4165 #define SXHASH_MAX_DEPTH 3
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 /* 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
4168 account. */
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 #define SXHASH_MAX_LEN 7
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 /* Combine two integers X and Y for hashing. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4173
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4174 #define SXHASH_COMBINE(X, Y) \
25709
ba4e2a641663 (SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents: 25690
diff changeset
4175 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4176 + (unsigned)(Y))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4177
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4178
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4179 /* Return a hash for string PTR which has length LEN. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4180
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4181 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4182 sxhash_string (ptr, len)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4183 unsigned char *ptr;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4184 int len;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4185 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4186 unsigned char *p = ptr;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4187 unsigned char *end = p + len;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4188 unsigned char c;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4189 unsigned hash = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4190
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4191 while (p != end)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4192 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4193 c = *p++;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4194 if (c >= 0140)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4195 c -= 40;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4196 hash = ((hash << 3) + (hash >> 28) + c);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4197 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4198
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4199 return hash & 07777777777;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4203 /* 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
4204 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
4205
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4206 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4207 sxhash_list (list, depth)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4208 Lisp_Object list;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4209 int depth;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4210 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4211 unsigned hash = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4212 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4213
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4214 if (depth < SXHASH_MAX_DEPTH)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4215 for (i = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4216 CONSP (list) && i < SXHASH_MAX_LEN;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4217 list = XCDR (list), ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4218 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4219 unsigned hash2 = sxhash (XCAR (list), depth + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4220 hash = SXHASH_COMBINE (hash, hash2);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4221 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4222
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4223 return hash;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4226
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4227 /* 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
4228 the Lisp structure. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4229
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4230 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4231 sxhash_vector (vec, depth)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4232 Lisp_Object vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4233 int depth;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4234 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4235 unsigned hash = XVECTOR (vec)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4236 int i, n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4237
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4238 n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4239 for (i = 0; i < n; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4240 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4241 unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4242 hash = SXHASH_COMBINE (hash, hash2);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4243 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4244
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4245 return hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4246 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4247
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4248
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4249 /* Return a hash for bool-vector VECTOR. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4250
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4251 static unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4252 sxhash_bool_vector (vec)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4253 Lisp_Object vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4254 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4255 unsigned hash = XBOOL_VECTOR (vec)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4256 int i, n;
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 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4259 for (i = 0; i < n; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4260 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4261
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4262 return hash;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4265
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4266 /* Return a hash code for OBJ. DEPTH is the current depth in the Lisp
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4267 structure. Value is an unsigned integer clipped to VALMASK. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4268
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4269 unsigned
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4270 sxhash (obj, depth)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4271 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4272 int depth;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4273 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4274 unsigned hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4275
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4276 if (depth > SXHASH_MAX_DEPTH)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4277 return 0;
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 switch (XTYPE (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4280 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4281 case Lisp_Int:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4282 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4283 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4284
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4285 case Lisp_Symbol:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4286 hash = sxhash_string (XSYMBOL (obj)->name->data,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4287 XSYMBOL (obj)->name->size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4288 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4289
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4290 case Lisp_Misc:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4291 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4292 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4293
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4294 case Lisp_String:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4295 hash = sxhash_string (XSTRING (obj)->data, XSTRING (obj)->size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4296 break;
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 /* This can be everything from a vector to an overlay. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4299 case Lisp_Vectorlike:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4300 if (VECTORP (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4301 /* 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
4302 they are `eq', except for strings and bit-vectors. In
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4303 Emacs, this works differently. We have to compare element
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4304 by element. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4305 hash = sxhash_vector (obj, depth);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4306 else if (BOOL_VECTOR_P (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4307 hash = sxhash_bool_vector (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4308 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4309 /* 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
4310 address as hash. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4311 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4312 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4313
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4314 case Lisp_Cons:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4315 hash = sxhash_list (obj, depth);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4316 break;
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 case Lisp_Float:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4319 {
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
4320 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
4321 unsigned char *e = p + sizeof XFLOAT_DATA (obj);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4322 for (hash = 0; p < e; ++p)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4323 hash = SXHASH_COMBINE (hash, *p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4324 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4325 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4326
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4327 default:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4328 abort ();
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4329 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4330
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4331 return hash & VALMASK;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4334
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4335
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 Lisp Interface
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4338 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4339
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4340
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4341 DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4342 "Compute a hash code for OBJ and return it as integer.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4343 (obj)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4344 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4345 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4346 unsigned hash = sxhash (obj, 0);;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4347 return make_number (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4348 }
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 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4352 "Create and return a new hash table.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4353 Arguments are specified as keyword/argument pairs. The following\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4354 arguments are defined:\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4355 \n\
25690
0e71134aaba2 (Fmake_hash_table): Fix string continuation.
Dave Love <fx@gnu.org>
parents: 25645
diff changeset
4356 :TEST TEST -- TEST must be a symbol that specifies how to compare keys.\n\
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4357 Default is `eql'. Predefined are the tests `eq', `eql', and `equal'.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4358 User-supplied test and hash functions can be specified via\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4359 `define-hash-table-test'.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4360 \n\
25690
0e71134aaba2 (Fmake_hash_table): Fix string continuation.
Dave Love <fx@gnu.org>
parents: 25645
diff changeset
4361 :SIZE SIZE -- A hint as to how many elements will be put in the table.\n\
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4362 Default is 65.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4363 \n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4364 :REHASH-SIZE REHASH-SIZE - Indicates how to expand the table when\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4365 it fills up. If REHASH-SIZE is an integer, add that many space.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4366 If it is a float, it must be > 1.0, and the new size is computed by\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4367 multiplying the old size with that factor. Default is 1.5.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4368 \n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4369 :REHASH-THRESHOLD THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4370 Resize the hash table when ratio of the number of entries in the table.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4371 Default is 0.8.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4372 \n\
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4373 :WEAKNESS WEAK -- WEAK must be one of nil, t, `key', or `value'.\n\
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4374 If WEAK is not nil, the table returned is a weak table. Key/value\n\
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4375 pairs are removed from a weak hash table when their key, value or both\n\
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4376 (WEAK t) are otherwise unreferenced. Default is nil.")
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4377 (nargs, args)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4378 int nargs;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4379 Lisp_Object *args;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4380 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4381 Lisp_Object test, size, rehash_size, rehash_threshold, weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4382 Lisp_Object user_test, user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4383 char *used;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4384 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4385
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4386 /* 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
4387 have been consumed. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4388 used = (char *) alloca (nargs * sizeof *used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4389 bzero (used, nargs * sizeof *used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4390
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4391 /* See if there's a `:test TEST' among the arguments. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4392 i = get_key_arg (QCtest, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4393 test = i < 0 ? Qeql : args[i];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4394 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4395 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4396 /* See if it is a user-defined test. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4397 Lisp_Object prop;
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 prop = Fget (test, Qhash_table_test);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4400 if (!CONSP (prop) || XFASTINT (Flength (prop)) < 2)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4401 Fsignal (Qerror, list2 (build_string ("Illegal hash table test"),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4402 test));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4403 user_test = Fnth (make_number (0), prop);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4404 user_hash = Fnth (make_number (1), prop);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4405 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4406 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4407 user_test = user_hash = Qnil;
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 /* See if there's a `:size SIZE' argument. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4410 i = get_key_arg (QCsize, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4411 size = i < 0 ? make_number (DEFAULT_HASH_SIZE) : args[i];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4412 if (!INTEGERP (size) || XINT (size) <= 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4413 Fsignal (Qerror,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4414 list2 (build_string ("Illegal hash table size"),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4415 size));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4416
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4417 /* Look for `:rehash-size SIZE'. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4418 i = get_key_arg (QCrehash_size, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4419 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
4420 if (!NUMBERP (rehash_size)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4421 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4422 || XFLOATINT (rehash_size) <= 1.0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4423 Fsignal (Qerror,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4424 list2 (build_string ("Illegal hash table rehash size"),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4425 rehash_size));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4426
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4427 /* Look for `:rehash-threshold THRESHOLD'. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4428 i = get_key_arg (QCrehash_threshold, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4429 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
4430 if (!FLOATP (rehash_threshold)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4431 || XFLOATINT (rehash_threshold) <= 0.0
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4432 || XFLOATINT (rehash_threshold) > 1.0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4433 Fsignal (Qerror,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4434 list2 (build_string ("Illegal hash table rehash threshold"),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4435 rehash_threshold));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4436
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4437 /* Look for `:weakness WEAK'. */
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4438 i = get_key_arg (QCweakness, nargs, args, used);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4439 weak = i < 0 ? Qnil : args[i];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4440 if (!NILP (weak)
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4441 && !EQ (weak, Qt)
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4442 && !EQ (weak, Qkey)
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4443 && !EQ (weak, Qvalue))
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4444 Fsignal (Qerror, list2 (build_string ("Illegal hash table weakness"),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4445 weak));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4446
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4447 /* 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
4448 for (i = 0; i < nargs; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4449 if (!used[i])
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4450 Fsignal (Qerror,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4451 list2 (build_string ("Invalid argument list"), args[i]));
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 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
4454 user_test, user_hash);
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4457
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4458 DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0,
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4459 "Return a copy of hash table TABLE.")
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4460 (table)
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4461 Lisp_Object table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4462 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4463 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
4464 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4465
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4466
25619
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4467 DEFUN ("makehash", Fmakehash, Smakehash, 0, 1, 0,
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4468 "Create a new hash table.\n\
25539
f6a59e53dac6 (Fmakehash): Exchange optional test and size arguments.
Gerd Moellmann <gerd@gnu.org>
parents: 25501
diff changeset
4469 Optional first argument TEST specifies how to compare keys in\n\
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4470 the table. Predefined tests are `eq', `eql', and `equal'. Default\n\
25619
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4471 is `eql'. New tests can be defined with `define-hash-table-test'.")
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4472 (test)
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4473 Lisp_Object test;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4474 {
25619
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4475 Lisp_Object args[2];
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4476 args[0] = QCtest;
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4477 args[1] = test;
f25a14690a18 (Fmakehash): Accept just one optional argument TEST.
Gerd Moellmann <gerd@gnu.org>
parents: 25607
diff changeset
4478 return Fmake_hash_table (2, args);
25005
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4481
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4482 DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4483 "Return the number of elements in TABLE.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4484 (table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4485 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4486 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4487 return check_hash_table (table)->count;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4488 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4489
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4490
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4491 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4492 Shash_table_rehash_size, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4493 "Return the current rehash size of TABLE.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4494 (table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4495 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4496 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4497 return check_hash_table (table)->rehash_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4498 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4499
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4500
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4501 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4502 Shash_table_rehash_threshold, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4503 "Return the current rehash threshold of TABLE.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4504 (table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4505 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4506 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4507 return check_hash_table (table)->rehash_threshold;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4508 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4509
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4510
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4511 DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4512 "Return the size of TABLE.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4513 The size can be used as an argument to `make-hash-table' to create\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4514 a hash table than can hold as many elements of TABLE holds\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4515 without need for resizing.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4516 (table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4517 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4518 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4519 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4520 return make_number (HASH_TABLE_SIZE (h));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4521 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4522
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4523
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4524 DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4525 "Return the test TABLE uses.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4526 (table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4527 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4528 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4529 return check_hash_table (table)->test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4530 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4531
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4532
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
4533 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
4534 1, 1, 0,
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4535 "Return the weakness of TABLE.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4536 (table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4537 Lisp_Object table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4538 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4539 return check_hash_table (table)->weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4540 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4541
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4542
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4543 DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4544 "Return t if OBJ is a Lisp hash table object.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4545 (obj)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4546 Lisp_Object obj;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4547 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4548 return HASH_TABLE_P (obj) ? Qt : Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4549 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4550
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 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4553 "Clear hash table TABLE.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4554 (table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4555 Lisp_Object table;
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 hash_clear (check_hash_table (table));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4558 return Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4559 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4560
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4561
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4562 DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4563 "Look up KEY in TABLE and return its associated value.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4564 If KEY is not found, return DFLT which defaults to nil.")
25080
46c21258f1ff (Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents: 25071
diff changeset
4565 (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
4566 Lisp_Object key, table, dflt;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4567 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4568 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4569 int i = hash_lookup (h, key, NULL);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4570 return i >= 0 ? HASH_VALUE (h, i) : dflt;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4571 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4572
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 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4575 "Associate KEY with VALUE is hash table TABLE.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4576 If KEY is already present in table, replace its current value with\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4577 VALUE.")
25080
46c21258f1ff (Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents: 25071
diff changeset
4578 (key, value, table)
46c21258f1ff (Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents: 25071
diff changeset
4579 Lisp_Object key, value, table;
25005
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 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4582 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4583 unsigned hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4584
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4585 i = hash_lookup (h, key, &hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4586 if (i >= 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4587 HASH_VALUE (h, i) = value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4588 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4589 hash_put (h, key, value, hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4590
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4591 return Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4592 }
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4595 DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4596 "Remove KEY from TABLE.")
25080
46c21258f1ff (Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents: 25071
diff changeset
4597 (key, table)
46c21258f1ff (Fgethash): Fix order of variables (patch by gerd).
Markus Rost <rost@math.uni-bielefeld.de>
parents: 25071
diff changeset
4598 Lisp_Object key, table;
25005
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 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4601 hash_remove (h, key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4602 return Qnil;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4605
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4606 DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4607 "Call FUNCTION for all entries in hash table TABLE.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4608 FUNCTION is called with 2 arguments KEY and VALUE.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4609 (function, table)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4610 Lisp_Object function, table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4611 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4612 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4613 Lisp_Object args[3];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4614 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4615
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4616 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4617 if (!NILP (HASH_HASH (h, i)))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4618 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4619 args[0] = function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4620 args[1] = HASH_KEY (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4621 args[2] = HASH_VALUE (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4622 Ffuncall (3, args);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4623 }
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 return Qnil;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4628
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4629 DEFUN ("define-hash-table-test", Fdefine_hash_table_test,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4630 Sdefine_hash_table_test, 3, 3, 0,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4631 "Define a new hash table test with name NAME, a symbol.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4632 In hash tables create with NAME specified as test, use TEST to compare\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4633 keys, and HASH for computing hash codes of keys.\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4634 \n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4635 TEST must be a function taking two arguments and returning non-nil\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4636 if both arguments are the same. HASH must be a function taking\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4637 one argument and return an integer that is the hash code of the\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4638 argument. Hash code computation should use the whole value range of\n\
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4639 integers, including negative integers.")
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4640 (name, test, hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4641 Lisp_Object name, test, hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4642 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4643 return Fput (name, Qhash_table_test, list2 (test, hash));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4644 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4645
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4646
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4647
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4648
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
4649 void
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4650 syms_of_fns ()
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4651 {
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4652 /* Hash table stuff. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4653 Qhash_table_p = intern ("hash-table-p");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4654 staticpro (&Qhash_table_p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4655 Qeq = intern ("eq");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4656 staticpro (&Qeq);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4657 Qeql = intern ("eql");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4658 staticpro (&Qeql);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4659 Qequal = intern ("equal");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4660 staticpro (&Qequal);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4661 QCtest = intern (":test");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4662 staticpro (&QCtest);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4663 QCsize = intern (":size");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4664 staticpro (&QCsize);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4665 QCrehash_size = intern (":rehash-size");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4666 staticpro (&QCrehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4667 QCrehash_threshold = intern (":rehash-threshold");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4668 staticpro (&QCrehash_threshold);
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4669 QCweakness = intern (":weakness");
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4670 staticpro (&QCweakness);
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4671 Qkey = intern ("key");
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4672 staticpro (&Qkey);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4673 Qvalue = intern ("value");
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4674 staticpro (&Qvalue);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4675 Qhash_table_test = intern ("hash-table-test");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4676 staticpro (&Qhash_table_test);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4677
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4678 defsubr (&Ssxhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4679 defsubr (&Smake_hash_table);
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4680 defsubr (&Scopy_hash_table);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4681 defsubr (&Smakehash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4682 defsubr (&Shash_table_count);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4683 defsubr (&Shash_table_rehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4684 defsubr (&Shash_table_rehash_threshold);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4685 defsubr (&Shash_table_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4686 defsubr (&Shash_table_test);
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
4687 defsubr (&Shash_table_weakness);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4688 defsubr (&Shash_table_p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4689 defsubr (&Sclrhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4690 defsubr (&Sgethash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4691 defsubr (&Sputhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4692 defsubr (&Sremhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4693 defsubr (&Smaphash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4694 defsubr (&Sdefine_hash_table_test);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4695
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4696 Qstring_lessp = intern ("string-lessp");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4697 staticpro (&Qstring_lessp);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
4698 Qprovide = intern ("provide");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
4699 staticpro (&Qprovide);
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
4700 Qrequire = intern ("require");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
4701 staticpro (&Qrequire);
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
4702 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
4703 staticpro (&Qyes_or_no_p_history);
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
4704 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
4705 staticpro (&Qcursor_in_echo_area);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4706 Qwidget_type = intern ("widget-type");
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4707 staticpro (&Qwidget_type);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4708
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
4709 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
4710 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
4711
14486
3c4ba112108e (syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents: 14456
diff changeset
4712 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
4713
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4714 DEFVAR_LISP ("features", &Vfeatures,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4715 "A list of symbols which are the features of the executing emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4716 Used by `featurep' and `require', and altered by `provide'.");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4717 Vfeatures = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4718
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
4719 DEFVAR_BOOL ("use-dialog-box", &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
4720 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
18686
186f1b58028d (syms_of_fns): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 18613
diff changeset
4721 This applies to y-or-n and yes-or-no questions asked by commands\n\
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
4722 invoked by mouse clicks and mouse menu items.");
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
4723 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
4724
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4725 defsubr (&Sidentity);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4726 defsubr (&Srandom);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4727 defsubr (&Slength);
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
4728 defsubr (&Ssafe_length);
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
4729 defsubr (&Sstring_bytes);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4730 defsubr (&Sstring_equal);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
4731 defsubr (&Scompare_strings);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4732 defsubr (&Sstring_lessp);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4733 defsubr (&Sappend);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4734 defsubr (&Sconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4735 defsubr (&Svconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4736 defsubr (&Scopy_sequence);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
4737 defsubr (&Sstring_make_multibyte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
4738 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
4739 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
4740 defsubr (&Sstring_as_unibyte);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4741 defsubr (&Scopy_alist);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4742 defsubr (&Ssubstring);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4743 defsubr (&Snthcdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4744 defsubr (&Snth);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4745 defsubr (&Selt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4746 defsubr (&Smember);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4747 defsubr (&Smemq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4748 defsubr (&Sassq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4749 defsubr (&Sassoc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4750 defsubr (&Srassq);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
4751 defsubr (&Srassoc);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4752 defsubr (&Sdelq);
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
4753 defsubr (&Sdelete);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4754 defsubr (&Snreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4755 defsubr (&Sreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4756 defsubr (&Ssort);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
4757 defsubr (&Splist_get);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4758 defsubr (&Sget);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
4759 defsubr (&Splist_put);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4760 defsubr (&Sput);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4761 defsubr (&Sequal);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4762 defsubr (&Sfillarray);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
4763 defsubr (&Schar_table_subtype);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
4764 defsubr (&Schar_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
4765 defsubr (&Sset_char_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
4766 defsubr (&Schar_table_extra_slot);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
4767 defsubr (&Sset_char_table_extra_slot);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
4768 defsubr (&Schar_table_range);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
4769 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
4770 defsubr (&Sset_char_table_default);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
4771 defsubr (&Smap_char_table);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4772 defsubr (&Snconc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4773 defsubr (&Smapcar);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4774 defsubr (&Smapconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4775 defsubr (&Sy_or_n_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4776 defsubr (&Syes_or_no_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4777 defsubr (&Sload_average);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4778 defsubr (&Sfeaturep);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4779 defsubr (&Srequire);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4780 defsubr (&Sprovide);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4781 defsubr (&Swidget_plist_member);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4782 defsubr (&Swidget_put);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4783 defsubr (&Swidget_get);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4784 defsubr (&Swidget_apply);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4785 defsubr (&Sbase64_encode_region);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4786 defsubr (&Sbase64_decode_region);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4787 defsubr (&Sbase64_encode_string);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4788 defsubr (&Sbase64_decode_string);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4789 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4790
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4791
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4792 void
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4793 init_fns ()
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4794 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4795 Vweak_hash_tables = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4796 }