annotate src/fns.c @ 112445:93fcbcb698b0

Improve configuration of makeinfo. * Makefile.in (MAKEINFO): Now controlled by `configure'. (MAKEINFO_OPTS): New variable. Use it where appropriate. (ENVADD): Updated.
author Werner Lemberg <wl@gnu.org>
date Sun, 23 Jan 2011 11:38:14 +0100
parents aa1e27e3a554
children
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.
64770
a0d1312ede66 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64484
diff changeset
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997,
a0d1312ede66 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64484
diff changeset
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
112160
6bac5e026755 * src/fns.c (Fyes_or_no_p): Add usage.
Andreas Schwab <schwab@linux-m68k.org>
parents: 112139
diff changeset
4 2005, 2006, 2007, 2008, 2009, 2010, 2011
108933
b465aa3255ed Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents: 106815
diff changeset
5 Free Software Foundation, Inc.
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 This file is part of GNU Emacs.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8
94963
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94929
diff changeset
9 GNU Emacs is free software: you can redistribute it and/or modify
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10 it under the terms of the GNU General Public License as published by
94963
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94929
diff changeset
11 the Free Software Foundation, either version 3 of the License, or
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94929
diff changeset
12 (at your option) any later version.
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU Emacs is distributed in the hope that it will be useful,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 GNU General Public License for more details.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
94963
8971ddf55736 Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94929
diff changeset
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4616
diff changeset
22 #include <config.h>
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
24 #include <unistd.h>
21841
12c75f0ef578 Include <time.h> for time.
Andreas Schwab <schwab@suse.de>
parents: 21810
diff changeset
25 #include <time.h>
105669
68dd71358159 * alloc.c: Do not define struct catchtag.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105661
diff changeset
26 #include <setjmp.h>
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
27
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28 /* Note on some machines this defines `vector' as a typedef,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 so make sure we don't use that name in this file. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 #undef vector
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 #define vector *****
50301
c0f3ec529c05 Allow building on Mac OS X again after Kim's merging of display code.
Andrew Choi <akochoi@shaw.ca>
parents: 49915
diff changeset
32
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33 #include "lisp.h"
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 #include "commands.h"
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
35 #include "character.h"
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
36 #include "coding.h"
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37 #include "buffer.h"
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
38 #include "keyboard.h"
39697
0b986bb45526 Include keymap.h.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39682
diff changeset
39 #include "keymap.h"
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
40 #include "intervals.h"
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
41 #include "frame.h"
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
42 #include "window.h"
37319
b481b8cc3923 Include blockinput.h.
Gerd Moellmann <gerd@gnu.org>
parents: 37317
diff changeset
43 #include "blockinput.h"
69957
0a13b0324d7a [HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 69655
diff changeset
44 #ifdef HAVE_MENUS
0a13b0324d7a [HAVE_MENUS && MAC_OS]: Include macterm.h.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
parents: 69655
diff changeset
45 #if defined (HAVE_X_WINDOWS)
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
46 #include "xterm.h"
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
47 #endif
105683
f08ab3de7d1e * fns.c: Add #endif accidentally removed in previous change.
Juanma Barranquero <lekktu@gmail.com>
parents: 105678
diff changeset
48 #endif /* HAVE_MENUS */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
49
12062
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
50 #ifndef NULL
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
51 #define NULL ((POINTER_TYPE *)0)
12062
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
52 #endif
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
53
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
54 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
55 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
56 Lisp_Object Qcursor_in_echo_area;
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
57 Lisp_Object Qwidget_type;
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
58 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59
109100
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
60 static int internal_equal (Lisp_Object , Lisp_Object, int, int);
21580
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
61
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
62 extern long get_random (void);
109100
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
63 extern void seed_random (long);
21580
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
64
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
65 #ifndef HAVE_UNISTD_H
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
66 extern long time ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
67 #endif
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
68
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
41006
fd83ec62a495 Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 40985
diff changeset
70 doc: /* Return the argument unchanged. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
71 (Lisp_Object arg)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
73 return arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
77 doc: /* Return a pseudo-random number.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
78 All integers representable in Lisp are equally likely.
53255
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
79 On most systems, this is 29 bits' worth.
99419
7ef18b2a2781 * fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 97454
diff changeset
80 With positive integer LIMIT, return random number in interval [0,LIMIT).
7ef18b2a2781 * fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 97454
diff changeset
81 With argument t, set the random number seed from the current time and pid.
7ef18b2a2781 * fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 97454
diff changeset
82 Other values of LIMIT are ignored. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
83 (Lisp_Object limit)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84 {
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
85 EMACS_INT val;
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
86 Lisp_Object lispy_val;
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
87 unsigned long denominator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88
99419
7ef18b2a2781 * fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 97454
diff changeset
89 if (EQ (limit, Qt))
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
90 seed_random (getpid () + time (NULL));
99419
7ef18b2a2781 * fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 97454
diff changeset
91 if (NATNUMP (limit) && XFASTINT (limit) != 0)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 {
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
93 /* 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
94 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
95 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
96 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
97 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
98 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
99 when using a large n. */
99419
7ef18b2a2781 * fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 97454
diff changeset
100 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
101 do
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
102 val = get_random () / denominator;
99419
7ef18b2a2781 * fns.c (Frandom): Rename arg N to LIMIT to match the docs; doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 97454
diff changeset
103 while (val >= XFASTINT (limit));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104 }
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
105 else
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
106 val = get_random ();
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
107 XSETINT (lispy_val, val);
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
108 return lispy_val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111 /* Random data-structure functions */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 DEFUN ("length", Flength, Slength, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
114 doc: /* Return the length of vector, list or string SEQUENCE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
115 A byte-code function object is also allowed.
47762
aa5414c0e056 (Flength): Doc fix.
John Paul Wallington <jpw@pobox.com>
parents: 46425
diff changeset
116 If the string contains multibyte characters, this is not necessarily
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
117 the number of bytes in the string; it is the number of characters.
73926
21f6be2e8ecb (Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents: 73686
diff changeset
118 To get the number of bytes, use `string-bytes'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
119 (register Lisp_Object sequence)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 {
34961
d033c08f2ac6 (Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents: 34722
diff changeset
121 register Lisp_Object val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
124 if (STRINGP (sequence))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
125 XSETFASTINT (val, SCHARS (sequence));
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
126 else if (VECTORP (sequence))
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
127 XSETFASTINT (val, ASIZE (sequence));
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
128 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
129 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
130 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
131 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
132 else if (COMPILEDP (sequence))
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
133 XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
134 else if (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135 {
26256
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
136 i = 0;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
137 while (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
139 sequence = XCDR (sequence);
26256
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
140 ++i;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
141
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
142 if (!CONSP (sequence))
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
143 break;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
144
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
145 sequence = XCDR (sequence);
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
146 ++i;
144cf26f35e1 (Flength): Unroll loop over lists.
Gerd Moellmann <gerd@gnu.org>
parents: 26230
diff changeset
147 QUIT;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
150 CHECK_LIST_END (sequence, sequence);
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
151
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
152 val = make_number (i);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 }
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
154 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
155 XSETFASTINT (val, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 else
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
157 wrong_type_argument (Qsequencep, sequence);
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
158
9965
f68eab303ddb (Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents: 9927
diff changeset
159 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161
61723
afe4f19c3436 (Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents: 61687
diff changeset
162 /* This does not check for quits. That is safe since it must terminate. */
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
163
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
164 DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
165 doc: /* Return the length of a list, but avoid error or infinite loop.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
166 This function never gets an error. If LIST is not really a list,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
167 it returns 0. If LIST is circular, it returns a finite value
73926
21f6be2e8ecb (Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents: 73686
diff changeset
168 which is at least the number of distinct elements. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
169 (Lisp_Object list)
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
170 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
171 Lisp_Object tail, halftail, length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
172 int len = 0;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
173
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
174 /* halftail is used to detect circular lists. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
175 halftail = list;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
176 for (tail = list; CONSP (tail); tail = XCDR (tail))
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
177 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
178 if (EQ (tail, halftail) && len != 0)
12618
60c4c0fee545 (Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents: 12466
diff changeset
179 break;
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
180 len++;
13344
30e17254a280 (Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents: 13277
diff changeset
181 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
182 halftail = XCDR (halftail);
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
183 }
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
184
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
185 XSETINT (length, len);
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
186 return length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
187 }
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
188
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
189 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
190 doc: /* Return the number of bytes in STRING.
90667
dbe3f29e61d6 Merge from emacs--devo--0
Miles Bader <miles@gnu.org>
parents: 90650 74101
diff changeset
191 If STRING is multibyte, this may be greater than the length of STRING. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
192 (Lisp_Object string)
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
193 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
194 CHECK_STRING (string);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
195 return make_number (SBYTES (string));
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
196 }
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
197
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
199 doc: /* Return t if two strings have identical contents.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
200 Case is significant, but text properties are ignored.
73926
21f6be2e8ecb (Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents: 73686
diff changeset
201 Symbols are also allowed; their print names are used instead. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
202 (register Lisp_Object s1, Lisp_Object s2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
203 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
204 if (SYMBOLP (s1))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
205 s1 = SYMBOL_NAME (s1);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
206 if (SYMBOLP (s2))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
207 s2 = SYMBOL_NAME (s2);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
208 CHECK_STRING (s1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
209 CHECK_STRING (s2);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
210
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
211 if (SCHARS (s1) != SCHARS (s2)
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
212 || SBYTES (s1) != SBYTES (s2)
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
213 || memcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
218 DEFUN ("compare-strings", Fcompare_strings, Scompare_strings, 6, 7, 0,
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
219 doc: /* Compare the contents of two strings, converting to multibyte if needed.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
220 In string STR1, skip the first START1 characters and stop at END1.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
221 In string STR2, skip the first START2 characters and stop at END2.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
222 END1 and END2 default to the full lengths of the respective strings.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
223
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
224 Case is significant in this comparison if IGNORE-CASE is nil.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
225 Unibyte strings are converted to multibyte for comparison.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
226
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
227 The value is t if the strings (or specified portions) match.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
228 If string STR1 is less, the value is a negative number N;
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
229 - 1 - N is the number of characters that match at the beginning.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
230 If string STR1 is greater, the value is a positive number N;
73926
21f6be2e8ecb (Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents: 73686
diff changeset
231 N - 1 is the number of characters that match at the beginning. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
232 (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
233 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
234 register EMACS_INT end1_char, end2_char;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
235 register EMACS_INT i1, i1_byte, i2, i2_byte;
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
236
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
237 CHECK_STRING (str1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
238 CHECK_STRING (str2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
239 if (NILP (start1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
240 start1 = make_number (0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
241 if (NILP (start2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
242 start2 = make_number (0);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
243 CHECK_NATNUM (start1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
244 CHECK_NATNUM (start2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
245 if (! NILP (end1))
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
246 CHECK_NATNUM (end1);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
247 if (! NILP (end2))
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
248 CHECK_NATNUM (end2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
249
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
250 i1 = XINT (start1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
251 i2 = XINT (start2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
252
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
253 i1_byte = string_char_to_byte (str1, i1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
254 i2_byte = string_char_to_byte (str2, i2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
255
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
256 end1_char = SCHARS (str1);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
257 if (! NILP (end1) && end1_char > XINT (end1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
258 end1_char = XINT (end1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
259
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
260 end2_char = SCHARS (str2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
261 if (! NILP (end2) && end2_char > XINT (end2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
262 end2_char = XINT (end2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
263
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
264 while (i1 < end1_char && i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
265 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
266 /* When we find a mismatch, we must compare the
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
267 characters, not just the bytes. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
268 int c1, c2;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
269
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
270 if (STRING_MULTIBYTE (str1))
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
271 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
272 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
273 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
274 c1 = SREF (str1, i1++);
105661
bac26aa40069 Remove leftover table unibyte_to_multibyte_table.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104972
diff changeset
275 MAKE_CHAR_MULTIBYTE (c1);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
276 }
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 if (STRING_MULTIBYTE (str2))
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
279 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
280 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
281 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
282 c2 = SREF (str2, i2++);
105661
bac26aa40069 Remove leftover table unibyte_to_multibyte_table.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104972
diff changeset
283 MAKE_CHAR_MULTIBYTE (c2);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
284 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
285
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
286 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
287 continue;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
288
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
289 if (! NILP (ignore_case))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
290 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
291 Lisp_Object tem;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
292
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
293 tem = Fupcase (make_number (c1));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
294 c1 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
295 tem = Fupcase (make_number (c2));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
296 c2 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
297 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
298
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
299 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
300 continue;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
301
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
302 /* Note that I1 has already been incremented
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
303 past the character that we are comparing;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
304 hence we don't add or subtract 1 here. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
305 if (c1 < c2)
37309
aecc289cb0de (Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents: 37279
diff changeset
306 return make_number (- i1 + XINT (start1));
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
307 else
37309
aecc289cb0de (Fcompare_strings): Fix return values.
Gerd Moellmann <gerd@gnu.org>
parents: 37279
diff changeset
308 return make_number (i1 - XINT (start1));
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
309 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
310
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
311 if (i1 < end1_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
312 return make_number (i1 - XINT (start1) + 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
313 if (i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
314 return make_number (- i1 + XINT (start1) - 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
315
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
316 return Qt;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
317 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
318
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
319 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
320 doc: /* Return t if first arg string is less than second in lexicographic order.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
321 Case is significant.
73926
21f6be2e8ecb (Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents: 73686
diff changeset
322 Symbols are also allowed; their print names are used instead. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
323 (register Lisp_Object s1, Lisp_Object s2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
324 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
325 register EMACS_INT end;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
326 register EMACS_INT i1, i1_byte, i2, i2_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
327
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
328 if (SYMBOLP (s1))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
329 s1 = SYMBOL_NAME (s1);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
330 if (SYMBOLP (s2))
45401
317e23417505 * fns.c (Fstring_equal, Fstring_lessp, Frequire, sxhash): Use
Ken Raeburn <raeburn@raeburn.org>
parents: 45039
diff changeset
331 s2 = SYMBOL_NAME (s2);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
332 CHECK_STRING (s1);
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
333 CHECK_STRING (s2);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
335 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
336
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
337 end = SCHARS (s1);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
338 if (end > SCHARS (s2))
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
339 end = SCHARS (s2);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
340
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
341 while (i1 < end)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
342 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
343 /* 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
344 characters, not just the bytes. */
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
345 int c1, c2;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
346
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
347 FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
348 FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
349
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
350 if (c1 != c2)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
351 return c1 < c2 ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
352 }
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
353 return i1 < SCHARS (s2) ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
354 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355
109310
988ceb510e6b Remove obsolete noinline declaration
Andreas Schwab <schwab@linux-m68k.org>
parents: 109179
diff changeset
356 static Lisp_Object concat (int nargs, Lisp_Object *args,
988ceb510e6b Remove obsolete noinline declaration
Andreas Schwab <schwab@linux-m68k.org>
parents: 109179
diff changeset
357 enum Lisp_Type target_type, int last_special);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
359 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
360 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
361 concat2 (Lisp_Object s1, Lisp_Object s2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
366 return concat (2, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368
8966
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
369 /* ARGSUSED */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
370 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
371 concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
8966
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
372 {
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
373 Lisp_Object args[3];
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
374 args[0] = s1;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
375 args[1] = s2;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
376 args[2] = s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
377 return concat (3, args, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
378 }
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
379
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
381 doc: /* Concatenate all the arguments and make the result a list.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
382 The result is a list whose elements are the elements of all the arguments.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
383 Each argument may be a list, vector or string.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
384 The last argument is not copied, just used as the tail of the new list.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
385 usage: (append &rest SEQUENCES) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
386 (int nargs, Lisp_Object *args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388 return concat (nargs, args, Lisp_Cons, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
389 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
390
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
391 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
392 doc: /* Concatenate all the arguments and make the result a string.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
393 The result is a string whose elements are the elements of all the arguments.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
394 Each argument may be a string or a list or vector of characters (integers).
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
395 usage: (concat &rest SEQUENCES) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
396 (int nargs, Lisp_Object *args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 return concat (nargs, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
400
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
402 doc: /* Concatenate all the arguments and make the result a vector.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
403 The result is a vector whose elements are the elements of all the arguments.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
404 Each argument may be a list, vector or string.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
405 usage: (vconcat &rest SEQUENCES) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
406 (int nargs, Lisp_Object *args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 {
10006
402c87cbc4fa (Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9965
diff changeset
408 return concat (nargs, args, Lisp_Vectorlike, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
411
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
48320
de5246a3655a (Fcopy_sequence): Doc fix.
Dave Love <fx@gnu.org>
parents: 48271
diff changeset
413 doc: /* Return a copy of a list, vector, string or char-table.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
414 The elements of a list or vector are not copied; they are shared
73926
21f6be2e8ecb (Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents: 73686
diff changeset
415 with the original. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
416 (Lisp_Object arg)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
418 if (NILP (arg)) return arg;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
419
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
420 if (CHAR_TABLE_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
421 {
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
422 return copy_char_table (arg);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
423 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
424
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
425 if (BOOL_VECTOR_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
426 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
427 Lisp_Object val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
428 int size_in_chars
55161
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
429 = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
430 / BOOL_VECTOR_BITS_PER_CHAR);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
431
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
432 val = Fmake_bool_vector (Flength (arg), Qnil);
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
433 memcpy (XBOOL_VECTOR (val)->data, XBOOL_VECTOR (arg)->data,
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
434 size_in_chars);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
435 return val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
436 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
437
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
438 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
439 wrong_type_argument (Qsequencep, arg);
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
440
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
444 /* 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
445 a string and has text properties to be copied. */
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
446 struct textprop_rec
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
447 {
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
448 int argnum; /* refer to ARGS (arguments of `concat') */
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
449 EMACS_INT from; /* refer to ARGS[argnum] (argument string) */
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
450 EMACS_INT to; /* refer to VAL (the target string) */
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
451 };
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
452
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453 static Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
454 concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
455 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456 Lisp_Object val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458 register Lisp_Object this;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
459 EMACS_INT toindex;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
460 EMACS_INT toindex_byte = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
461 register EMACS_INT result_len;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
462 register EMACS_INT result_len_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464 Lisp_Object last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
465 Lisp_Object prev;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
466 int some_multibyte;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
467 /* 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
468 while concatinating each string because the length of resulting
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
469 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
470 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
471 here, and copy the text properties after the concatination. */
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
472 struct textprop_rec *textprops = NULL;
108933
b465aa3255ed Fix typos.
Juanma Barranquero <lekktu@gmail.com>
parents: 106815
diff changeset
473 /* Number of elements in textprops. */
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
474 int num_textprops = 0;
58623
834b3aeb850f (concat): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents: 58379
diff changeset
475 USE_SAFE_ALLOCA;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
477 tail = Qnil;
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
478
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 /* In append, the last arg isn't treated like the others */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 if (last_special && nargs > 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 nargs--;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 last_tail = args[nargs];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 last_tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
488 /* Check each argument. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 this = args[argnum];
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
492 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
493 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
494 wrong_type_argument (Qsequencep, this);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
496
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
497 /* 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
498 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
499 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
500 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
501 result_len_byte = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
502 result_len = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
503 some_multibyte = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
504 for (argnum = 0; argnum < nargs; argnum++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
505 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
506 EMACS_INT len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
507 this = args[argnum];
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
508 len = XFASTINT (Flength (this));
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
509 if (target_type == Lisp_String)
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
510 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
511 /* 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
512 as well as the number of characters. */
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
513 EMACS_INT i;
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
514 Lisp_Object ch;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
515 EMACS_INT this_len_byte;
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
516
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
517 if (VECTORP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
518 for (i = 0; i < len; i++)
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
519 {
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
520 ch = AREF (this, i);
90533
8a8e69664178 Merge from emacs--devo--0
Miles Bader <miles@gnu.org>
parents: 90428 71979
diff changeset
521 CHECK_CHARACTER (ch);
23128
45de23c16505 (concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents: 23057
diff changeset
522 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
523 result_len_byte += this_len_byte;
89527
7ca60ab7a039 (concat): Don't change multibyteness of the result by
Kenichi Handa <handa@m17n.org>
parents: 89483
diff changeset
524 if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
525 some_multibyte = 1;
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
526 }
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
527 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
528 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
529 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
530 for (; CONSP (this); this = XCDR (this))
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
531 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
532 ch = XCAR (this);
90533
8a8e69664178 Merge from emacs--devo--0
Miles Bader <miles@gnu.org>
parents: 90428 71979
diff changeset
533 CHECK_CHARACTER (ch);
23128
45de23c16505 (concat): Use macro CHAR_BYTES instead of Fchar_bytes.
Kenichi Handa <handa@m17n.org>
parents: 23057
diff changeset
534 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
535 result_len_byte += this_len_byte;
89527
7ca60ab7a039 (concat): Don't change multibyteness of the result by
Kenichi Handa <handa@m17n.org>
parents: 89483
diff changeset
536 if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
537 some_multibyte = 1;
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
538 }
20639
12240a9b3679 (concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents: 20607
diff changeset
539 else if (STRINGP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
540 {
20699
907d8633c8cc (concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents: 20667
diff changeset
541 if (STRING_MULTIBYTE (this))
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
542 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
543 some_multibyte = 1;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
544 result_len_byte += SBYTES (this);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
545 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
546 else
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
547 result_len_byte += count_size_as_multibyte (SDATA (this),
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
548 SCHARS (this));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
549 }
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
550 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
551
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
552 result_len += len;
101587
dfed39918c22 (concat): Check for string overflow (bug#1787).
Chong Yidong <cyd@stupidchicken.com>
parents: 101287
diff changeset
553 if (result_len < 0)
dfed39918c22 (concat): Check for string overflow (bug#1787).
Chong Yidong <cyd@stupidchicken.com>
parents: 101287
diff changeset
554 error ("String overflow");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
555 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
556
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
557 if (! some_multibyte)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
558 result_len_byte = result_len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
560 /* Create the output object. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
561 if (target_type == Lisp_Cons)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
562 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
563 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
564 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
565 else if (some_multibyte)
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
566 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
567 else
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
568 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
569
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
570 /* 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
571 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
572 return last_tail;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
573
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
574 /* Copy the contents of the args into the result. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
575 if (CONSP (val))
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
576 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
577 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
578 toindex = 0, toindex_byte = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
579
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
580 prev = Qnil;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
581 if (STRINGP (val))
58623
834b3aeb850f (concat): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents: 58379
diff changeset
582 SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
583
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
584 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
585 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
586 Lisp_Object thislen;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
587 EMACS_INT thisleni = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
588 register EMACS_INT thisindex = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
589 register EMACS_INT thisindex_byte = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
590
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
591 this = args[argnum];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592 if (!CONSP (this))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593 thislen = Flength (this), thisleni = XINT (thislen);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
595 /* 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
596 if (STRINGP (this) && STRINGP (val)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
597 && 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
598 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
599 EMACS_INT thislen_byte = SBYTES (this);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
600
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
601 memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
602 if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
603 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
604 textprops[num_textprops].argnum = argnum;
55481
53ac9afa3d0a (count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents: 55161
diff changeset
605 textprops[num_textprops].from = 0;
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
606 textprops[num_textprops++].to = toindex;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
607 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
608 toindex_byte += thislen_byte;
55481
53ac9afa3d0a (count_combining): Delete it.
Kenichi Handa <handa@m17n.org>
parents: 55161
diff changeset
609 toindex += thisleni;
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
610 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
611 /* 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
612 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
613 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
614 if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
615 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
616 textprops[num_textprops].argnum = argnum;
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
617 textprops[num_textprops].from = 0;
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
618 textprops[num_textprops++].to = toindex;
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
619 }
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
620 toindex_byte += copy_text (SDATA (this),
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
621 SDATA (val) + toindex_byte,
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
622 SCHARS (this), 0, 1);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
623 toindex += thisleni;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
624 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
625 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
626 /* Copy element by element. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
627 while (1)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
628 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
629 register Lisp_Object elt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
630
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
631 /* 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
632 `this' is exhausted. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
633 if (NILP (this)) break;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
634 if (CONSP (this))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
635 elt = XCAR (this), this = XCDR (this);
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
636 else if (thisindex >= thisleni)
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
637 break;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
638 else if (STRINGP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
639 {
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
640 int c;
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
641 if (STRING_MULTIBYTE (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
642 {
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
643 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
644 thisindex,
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
645 thisindex_byte);
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
646 XSETFASTINT (elt, c);
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
647 }
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
648 else
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
649 {
58265
491080266027 Avoid side-effects inside XSETFASTINT's arguments.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 58239
diff changeset
650 XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
23152
7cd25ebef713 (concat): If Vnonascii_translation_table is non-nil, try
Kenichi Handa <handa@m17n.org>
parents: 23128
diff changeset
651 if (some_multibyte
105661
bac26aa40069 Remove leftover table unibyte_to_multibyte_table.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104972
diff changeset
652 && !ASCII_CHAR_P (XINT (elt))
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
653 && XINT (elt) < 0400)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
654 {
105661
bac26aa40069 Remove leftover table unibyte_to_multibyte_table.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104972
diff changeset
655 c = BYTE8_TO_CHAR (XINT (elt));
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
656 XSETINT (elt, c);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
657 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
658 }
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
659 }
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
660 else if (BOOL_VECTOR_P (this))
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
661 {
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
662 int byte;
55161
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
663 byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
664 if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
665 elt = Qt;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
666 else
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
667 elt = Qnil;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
668 thisindex++;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
669 }
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
670 else
91667
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
671 {
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
672 elt = AREF (this, thisindex);
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
673 thisindex++;
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
674 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
675
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
676 /* 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
677 if (toindex < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
678 {
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39968
diff changeset
679 XSETCAR (tail, elt);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
680 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
681 tail = XCDR (tail);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
682 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
683 else if (VECTORP (val))
91667
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
684 {
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
685 ASET (val, toindex, elt);
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
686 toindex++;
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
687 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
688 else
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
689 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
690 CHECK_NUMBER (elt);
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
691 if (some_multibyte)
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
692 toindex_byte += CHAR_STRING (XINT (elt),
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
693 SDATA (val) + toindex_byte);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
694 else
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
695 SSET (val, toindex_byte++, XINT (elt));
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
696 toindex++;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
698 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
699 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
700 if (!NILP (prev))
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39968
diff changeset
701 XSETCDR (prev, last_tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
702
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
703 if (num_textprops > 0)
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
704 {
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
705 Lisp_Object props;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
706 EMACS_INT last_to_end = -1;
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
707
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
708 for (argnum = 0; argnum < num_textprops; argnum++)
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
709 {
25094
4df3b9d95d4a (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 25093
diff changeset
710 this = args[textprops[argnum].argnum];
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
711 props = text_property_list (this,
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
712 make_number (0),
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
713 make_number (SCHARS (this)),
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
714 Qnil);
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
715 /* If successive arguments have properites, be sure that the
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
716 value of `composition' property be the copy. */
35352
42b56dd8986e (concat): Be sure to avoid putting the same `composition'
Kenichi Handa <handa@m17n.org>
parents: 35336
diff changeset
717 if (last_to_end == textprops[argnum].to)
30024
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
718 make_composition_value_copy (props);
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
719 add_text_properties_from_list (val, props,
9fd285caeb51 (concat): While copying text properties, make each composition
Kenichi Handa <handa@m17n.org>
parents: 30007
diff changeset
720 make_number (textprops[argnum].to));
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
721 last_to_end = textprops[argnum].to + SCHARS (this);
25093
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
722 }
30bfdf581d6f (count_combining): New function.
Kenichi Handa <handa@m17n.org>
parents: 25080
diff changeset
723 }
58623
834b3aeb850f (concat): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents: 58379
diff changeset
724
834b3aeb850f (concat): Use SAFE_ALLOCA.
Kim F. Storm <storm@cua.dk>
parents: 58379
diff changeset
725 SAFE_FREE ();
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
726 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
727 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
728
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
729 static Lisp_Object string_char_byte_cache_string;
91807
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
730 static EMACS_INT string_char_byte_cache_charpos;
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
731 static EMACS_INT string_char_byte_cache_bytepos;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
732
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
733 void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
734 clear_string_char_byte_cache (void)
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
735 {
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
736 string_char_byte_cache_string = Qnil;
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
737 }
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
738
91807
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
739 /* Return the byte index corresponding to CHAR_INDEX in STRING. */
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
740
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
741 EMACS_INT
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
742 string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
743 {
91807
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
744 EMACS_INT i_byte;
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
745 EMACS_INT best_below, best_below_byte;
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
746 EMACS_INT best_above, best_above_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
747
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
748 best_below = best_below_byte = 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
749 best_above = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
750 best_above_byte = SBYTES (string);
53742
2b23252ecc55 (string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents: 53681
diff changeset
751 if (best_above == best_above_byte)
2b23252ecc55 (string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents: 53681
diff changeset
752 return char_index;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
753
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
754 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
755 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
756 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
757 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
758 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
759 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
760 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
761 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
762 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
763 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
764 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
765 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
766 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
767
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
768 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
769 {
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
770 unsigned char *p = SDATA (string) + best_below_byte;
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
771
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
772 while (best_below < char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
773 {
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
774 p += BYTES_BY_CHAR_HEAD (*p);
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
775 best_below++;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
776 }
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
777 i_byte = p - SDATA (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
778 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
779 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
780 {
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
781 unsigned char *p = SDATA (string) + best_above_byte;
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
782
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
783 while (best_above > char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
784 {
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
785 p--;
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
786 while (!CHAR_HEAD_P (*p)) p--;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
787 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
788 }
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
789 i_byte = p - SDATA (string);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
790 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
791
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
792 string_char_byte_cache_bytepos = i_byte;
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
793 string_char_byte_cache_charpos = char_index;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
794 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
795
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
796 return i_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
797 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
798
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
799 /* 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
800
91807
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
801 EMACS_INT
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
802 string_byte_to_char (Lisp_Object string, EMACS_INT byte_index)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
803 {
91807
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
804 EMACS_INT i, i_byte;
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
805 EMACS_INT best_below, best_below_byte;
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
806 EMACS_INT best_above, best_above_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
807
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
808 best_below = best_below_byte = 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
809 best_above = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
810 best_above_byte = SBYTES (string);
53742
2b23252ecc55 (string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents: 53681
diff changeset
811 if (best_above == best_above_byte)
2b23252ecc55 (string_char_to_byte): Optimize for ASCII only string.
Kenichi Handa <handa@m17n.org>
parents: 53681
diff changeset
812 return byte_index;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
813
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
814 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
815 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
816 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
817 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
818 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
819 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
820 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
821 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
822 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
823 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
824 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
825 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
826 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
827
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
828 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
829 {
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
830 unsigned char *p = SDATA (string) + best_below_byte;
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
831 unsigned char *pend = SDATA (string) + byte_index;
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
832
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
833 while (p < pend)
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
834 {
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
835 p += BYTES_BY_CHAR_HEAD (*p);
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
836 best_below++;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
837 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
838 i = best_below;
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
839 i_byte = p - SDATA (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
840 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
841 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
842 {
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
843 unsigned char *p = SDATA (string) + best_above_byte;
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
844 unsigned char *pbeg = SDATA (string) + byte_index;
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
845
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
846 while (p > pbeg)
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
847 {
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
848 p--;
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
849 while (!CHAR_HEAD_P (*p)) p--;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
850 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
851 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
852 i = best_above;
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
853 i_byte = p - SDATA (string);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
854 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
855
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
856 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
857 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
858 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
859
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
860 return i;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
861 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
862
88980
90ed3c3cd1cc *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88953
diff changeset
863 /* Convert STRING to a multibyte string. */
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
864
112023
ac49e05bfcf2 Remove unused declarations
Andreas Schwab <schwab@linux-m68k.org>
parents: 110543
diff changeset
865 static Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
866 string_make_multibyte (Lisp_Object string)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
867 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
868 unsigned char *buf;
91807
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
869 EMACS_INT nbytes;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
870 Lisp_Object ret;
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
871 USE_SAFE_ALLOCA;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
872
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
873 if (STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
874 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
875
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
876 nbytes = count_size_as_multibyte (SDATA (string),
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
877 SCHARS (string));
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
878 /* 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
879 once converted. In that case, we can return STRING itself. */
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
880 if (nbytes == SBYTES (string))
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
881 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
882
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
883 SAFE_ALLOCA (buf, unsigned char *, nbytes);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
884 copy_text (SDATA (string), buf, SBYTES (string),
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
885 0, 1);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
886
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
887 ret = make_multibyte_string (buf, SCHARS (string), nbytes);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
888 SAFE_FREE ();
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
889
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
890 return ret;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
891 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
892
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
893
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
894 /* Convert STRING (if unibyte) to a multibyte string without changing
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
895 the number of characters. Characters 0200 trough 0237 are
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
896 converted to eight-bit characters. */
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
897
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
898 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
899 string_to_multibyte (Lisp_Object string)
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
900 {
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
901 unsigned char *buf;
91807
507bcfb4342c * coding.c (coding_set_destination): Use BEG_BYTE rather than hardcoding 1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91667
diff changeset
902 EMACS_INT nbytes;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
903 Lisp_Object ret;
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
904 USE_SAFE_ALLOCA;
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
905
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
906 if (STRING_MULTIBYTE (string))
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
907 return string;
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
908
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
909 nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
910 /* If all the chars are ASCII, they won't need any more bytes once
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
911 converted. */
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
912 if (nbytes == SBYTES (string))
49815
2a19e12053a4 (string_to_multibyte): Always return a multibyte string.
Kenichi Handa <handa@m17n.org>
parents: 49798
diff changeset
913 return make_multibyte_string (SDATA (string), nbytes, nbytes);
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
914
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
915 SAFE_ALLOCA (buf, unsigned char *, nbytes);
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
916 memcpy (buf, SDATA (string), SBYTES (string));
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
917 str_to_multibyte (buf, nbytes, SBYTES (string));
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
918
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
919 ret = make_multibyte_string (buf, SCHARS (string), nbytes);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
920 SAFE_FREE ();
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
921
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
922 return ret;
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
923 }
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
924
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
925
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
926 /* 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
927
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
928 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
929 string_make_unibyte (Lisp_Object string)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
930 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
931 EMACS_INT nchars;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
932 unsigned char *buf;
56147
6b858fb89033 * fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents: 55481
diff changeset
933 Lisp_Object ret;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
934 USE_SAFE_ALLOCA;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
935
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
936 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
937 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
938
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
939 nchars = SCHARS (string);
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
940
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
941 SAFE_ALLOCA (buf, unsigned char *, nchars);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
942 copy_text (SDATA (string), buf, SBYTES (string),
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
943 1, 0);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
944
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
945 ret = make_unibyte_string (buf, nchars);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
946 SAFE_FREE ();
56147
6b858fb89033 * fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents: 55481
diff changeset
947
6b858fb89033 * fns.c (string_to_multibyte): Use xmalloc/xfree instead of alloca.
Jan Djärv <jan.h.d@swipnet.se>
parents: 55481
diff changeset
948 return ret;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
949 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
950
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
951 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
952 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
953 doc: /* Return the multibyte equivalent of STRING.
53255
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
954 If STRING is unibyte and contains non-ASCII characters, the function
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
955 `unibyte-char-to-multibyte' is used to convert each unibyte character
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
956 to a multibyte character. In this case, the returned string is a
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
957 newly created string with no text properties. If STRING is multibyte
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
958 or entirely ASCII, it is returned unchanged. In particular, when
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
959 STRING is unibyte and entirely ASCII, the returned string is unibyte.
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
960 \(When the characters are all ASCII, Emacs primitives will treat the
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
961 string the same way whether it is unibyte or multibyte.) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
962 (Lisp_Object string)
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
963 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
964 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
965
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
966 return string_make_multibyte (string);
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
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
969 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
970 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
971 doc: /* Return the unibyte equivalent of STRING.
45650
dca52f93fdc0 (Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 45629
diff changeset
972 Multibyte character codes are converted to unibyte according to
dca52f93fdc0 (Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 45629
diff changeset
973 `nonascii-translation-table' or, if that is nil, `nonascii-insert-offset'.
dca52f93fdc0 (Fstring_make_unibyte): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 45629
diff changeset
974 If the lookup in the translation table fails, this function takes just
73926
21f6be2e8ecb (Frandom, Flength, Fsafe_length, Fstring_bytes, Fstring_equal, Fcompare_strings,
Juanma Barranquero <lekktu@gmail.com>
parents: 73686
diff changeset
975 the low 8 bits of each character. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
976 (Lisp_Object string)
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
977 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
978 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
979
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
980 return string_make_unibyte (string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
981 }
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
982
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
983 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
984 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
985 doc: /* Return a unibyte string with the same individual bytes as STRING.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
986 If STRING is unibyte, the result is STRING itself.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
987 Otherwise it is a newly created string, with no text properties.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
988 If STRING is multibyte and contains a character of charset
89909
68c22ea6027c Sync to HEAD
Kenichi Handa <handa@m17n.org>
parents: 89783
diff changeset
989 `eight-bit', it is converted to the corresponding single byte. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
990 (Lisp_Object string)
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
991 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
992 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
993
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
994 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
995 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
996 EMACS_INT bytes = SBYTES (string);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
997 unsigned char *str = (unsigned char *) xmalloc (bytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
998
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
999 memcpy (str, SDATA (string), bytes);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1000 bytes = str_as_unibyte (str, bytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1001 string = make_unibyte_string (str, bytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1002 xfree (str);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1003 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1004 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1005 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1006
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1007 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
1008 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1009 doc: /* Return a multibyte string with the same individual bytes as STRING.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1010 If STRING is multibyte, the result is STRING itself.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1011 Otherwise it is a newly created string, with no text properties.
89203
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1012
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1013 If STRING is unibyte and contains an individual 8-bit byte (i.e. not
89203
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1014 part of a correct utf-8 sequence), it is converted to the corresponding
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1015 multibyte character of charset `eight-bit'.
90144
e938d7220d86 (Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents: 90143
diff changeset
1016 See also `string-to-multibyte'.
e938d7220d86 (Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents: 90143
diff changeset
1017
61433
74a256d5f3ec (Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 61417
diff changeset
1018 Beware, this often doesn't really do what you think it does.
90144
e938d7220d86 (Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents: 90143
diff changeset
1019 It is similar to (decode-coding-string STRING 'utf-8-emacs).
61433
74a256d5f3ec (Fstring_as_multibyte, Fstring_to_multibyte): Docstring fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 61417
diff changeset
1020 If you're not sure, whether to use `string-as-multibyte' or
90144
e938d7220d86 (Fstring_as_multibyte): Fix the change for syncing with
Kenichi Handa <handa@m17n.org>
parents: 90143
diff changeset
1021 `string-to-multibyte', use `string-to-multibyte'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1022 (Lisp_Object 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 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1024 CHECK_STRING (string);
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1025
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1026 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
1027 {
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1028 Lisp_Object new_string;
110503
fda36a325177 Fix some more uses of int instead of EMACS_INT.
Eli Zaretskii <eliz@gnu.org>
parents: 110314
diff changeset
1029 EMACS_INT nchars, nbytes;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1030
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1031 parse_str_as_multibyte (SDATA (string),
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1032 SBYTES (string),
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1033 &nchars, &nbytes);
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1034 new_string = make_uninit_multibyte_string (nchars, nbytes);
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
1035 memcpy (SDATA (new_string), SDATA (string), SBYTES (string));
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1036 if (nbytes != SBYTES (string))
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1037 str_as_multibyte (SDATA (new_string), nbytes,
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1038 SBYTES (string), NULL);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
1039 string = new_string;
46379
18cf1d2514d9 * fns.c (Fstring_as_multibyte): Use STRING_SET_INTERVALS.
Ken Raeburn <raeburn@raeburn.org>
parents: 46374
diff changeset
1040 STRING_SET_INTERVALS (string, NULL_INTERVAL);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1041 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1042 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1043 }
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1044
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1045 DEFUN ("string-to-multibyte", Fstring_to_multibyte, Sstring_to_multibyte,
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1046 1, 1, 0,
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1047 doc: /* Return a multibyte string with the same individual chars as STRING.
49674
d7f7ccbc302a (Fstring_to_multibyte): Fix typo in the docstring.
Kenichi Handa <handa@m17n.org>
parents: 49656
diff changeset
1048 If STRING is multibyte, the result is STRING itself.
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1049 Otherwise it is a newly created string, with no text properties.
88953
b18e038d980f (Fstring_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 88864
diff changeset
1050
b18e038d980f (Fstring_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 88864
diff changeset
1051 If STRING is unibyte and contains an 8-bit byte, it is converted to
89203
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1052 the corresponding multibyte character of charset `eight-bit'.
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1053
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1054 This differs from `string-as-multibyte' by converting each byte of a correct
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1055 utf-8 sequence to an eight-bit character, not just bytes that don't form a
61d0db65f8e4 (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
Dave Love <fx@gnu.org>
parents: 89196
diff changeset
1056 correct sequence. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1057 (Lisp_Object string)
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1058 {
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1059 CHECK_STRING (string);
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1060
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1061 return string_to_multibyte (string);
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1062 }
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
1063
96248
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1064 DEFUN ("string-to-unibyte", Fstring_to_unibyte, Sstring_to_unibyte,
96502
ff7196ae78c9 (Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents: 96271
diff changeset
1065 1, 1, 0,
96248
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1066 doc: /* Return a unibyte string with the same individual chars as STRING.
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1067 If STRING is unibyte, the result is STRING itself.
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1068 Otherwise it is a newly created string, with no text properties,
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1069 where each `eight-bit' character is converted to the corresponding byte.
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1070 If STRING contains a non-ASCII, non-`eight-bit' character,
96502
ff7196ae78c9 (Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents: 96271
diff changeset
1071 an error is signaled. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1072 (Lisp_Object string)
96248
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1073 {
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1074 CHECK_STRING (string);
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1075
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1076 if (STRING_MULTIBYTE (string))
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1077 {
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1078 EMACS_INT chars = SCHARS (string);
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1079 unsigned char *str = (unsigned char *) xmalloc (chars);
96502
ff7196ae78c9 (Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents: 96271
diff changeset
1080 EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, 0);
ff7196ae78c9 (Fstring_to_unibyte): Delete the arg ACCEPT-LATIN-1.
Kenichi Handa <handa@m17n.org>
parents: 96271
diff changeset
1081
96248
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1082 if (converted < chars)
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1083 error ("Can't convert the %dth character to unibyte", converted);
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1084 string = make_unibyte_string (str, chars);
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1085 xfree (str);
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1086 }
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1087 return string;
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1088 }
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
1089
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1090
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1091 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1092 doc: /* Return a copy of ALIST.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1093 This is an alist which represents the same mapping from objects to objects,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1094 but does not share the alist structure with ALIST.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1095 The objects mapped (cars and cdrs of elements of the alist)
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1096 are shared, however.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1097 Elements of ALIST that are not conses are also shared. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1098 (Lisp_Object alist)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1099 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1100 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1101
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1102 CHECK_LIST (alist);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1103 if (NILP (alist))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1104 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1105 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
1106 for (tem = alist; CONSP (tem); tem = XCDR (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1107 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1108 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
1109 car = XCAR (tem);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1110
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1111 if (CONSP (car))
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39968
diff changeset
1112 XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1113 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1114 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1115 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1116
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1117 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
101287
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1118 doc: /* Return a new string whose contents are a substring of STRING.
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1119 The returned string consists of the characters between index FROM
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1120 \(inclusive) and index TO (exclusive) of STRING. FROM and TO are
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1121 zero-indexed: 0 means the first character of STRING. Negative values
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1122 are counted from the end of STRING. If TO is nil, the substring runs
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1123 to the end of STRING.
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1124
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1125 The STRING argument may also be a vector. In that case, the return
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1126 value is a new vector that contains the elements between index FROM
d0a16c6d0444 (Fsubstring): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 100951
diff changeset
1127 \(inclusive) and index TO (exclusive) of that vector argument. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1128 (Lisp_Object string, register Lisp_Object from, Lisp_Object to)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1129 {
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1130 Lisp_Object res;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1131 EMACS_INT size;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1132 EMACS_INT size_byte = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1133 EMACS_INT from_char, to_char;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1134 EMACS_INT from_byte = 0, to_byte = 0;
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1135
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1136 CHECK_VECTOR_OR_STRING (string);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1137 CHECK_NUMBER (from);
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1138
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1139 if (STRINGP (string))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1140 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1141 size = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1142 size_byte = SBYTES (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1143 }
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1144 else
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
1145 size = ASIZE (string);
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1146
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1147 if (NILP (to))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1148 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1149 to_char = size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1150 to_byte = size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1151 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1152 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1153 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1154 CHECK_NUMBER (to);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1155
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1156 to_char = XINT (to);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1157 if (to_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1158 to_char += size;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1159
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1160 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1161 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
1162 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1163
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1164 from_char = XINT (from);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1165 if (from_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1166 from_char += size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1167 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1168 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
1169
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1170 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
1171 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
1172 make_number (to_char));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1173
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1174 if (STRINGP (string))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1175 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1176 res = make_specified_string (SDATA (string) + from_byte,
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1177 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
1178 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1179 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
1180 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
1181 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1182 else
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
1183 res = Fvector (to_char - from_char, &AREF (string, from_char));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1184
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1185 return res;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1186 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1187
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1188
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1189 DEFUN ("substring-no-properties", Fsubstring_no_properties, Ssubstring_no_properties, 1, 3, 0,
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1190 doc: /* Return a substring of STRING, without text properties.
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
1191 It starts at index FROM and ends before TO.
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1192 TO may be nil or omitted; then the substring runs to the end of STRING.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1193 If FROM is nil or omitted, the substring starts at the beginning of STRING.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1194 If FROM or TO is negative, it counts from the end.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1195
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1196 With one argument, just copy STRING without its properties. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1197 (Lisp_Object string, register Lisp_Object from, Lisp_Object to)
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1198 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1199 EMACS_INT size, size_byte;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1200 EMACS_INT from_char, to_char;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1201 EMACS_INT from_byte, to_byte;
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1202
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1203 CHECK_STRING (string);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1204
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1205 size = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1206 size_byte = SBYTES (string);
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1207
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1208 if (NILP (from))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1209 from_char = from_byte = 0;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1210 else
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1211 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1212 CHECK_NUMBER (from);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1213 from_char = XINT (from);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1214 if (from_char < 0)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1215 from_char += size;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1216
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1217 from_byte = string_char_to_byte (string, from_char);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1218 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1219
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1220 if (NILP (to))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1221 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1222 to_char = size;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1223 to_byte = size_byte;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1224 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1225 else
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1226 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1227 CHECK_NUMBER (to);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1228
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1229 to_char = XINT (to);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1230 if (to_char < 0)
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1231 to_char += size;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1232
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1233 to_byte = string_char_to_byte (string, to_char);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1234 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1235
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1236 if (!(0 <= from_char && from_char <= to_char && to_char <= size))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1237 args_out_of_range_3 (string, make_number (from_char),
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1238 make_number (to_char));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1239
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1240 return make_specified_string (SDATA (string) + from_byte,
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1241 to_char - from_char, to_byte - from_byte,
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1242 STRING_MULTIBYTE (string));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1243 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1244
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1245 /* 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
1246 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
1247
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1248 Lisp_Object
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1249 substring_both (Lisp_Object string, EMACS_INT from, EMACS_INT from_byte,
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1250 EMACS_INT to, EMACS_INT to_byte)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1251 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1252 Lisp_Object res;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1253 EMACS_INT size;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
1254 EMACS_INT size_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1255
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1256 CHECK_VECTOR_OR_STRING (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1257
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1258 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1259 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1260 size = SCHARS (string);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1261 size_byte = SBYTES (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1262 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1263 else
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
1264 size = ASIZE (string);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1265
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1266 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
1267 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
1268
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1269 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1270 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1271 res = make_specified_string (SDATA (string) + from_byte,
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1272 to - from, to_byte - from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1273 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1274 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
1275 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
1276 }
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1277 else
74169
a2250a4829ad (substring_both): Add missing address operator.
Juanma Barranquero <lekktu@gmail.com>
parents: 74163
diff changeset
1278 res = Fvector (to - from, &AREF (string, from));
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1279
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1280 return res;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1281 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1282
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1283 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
1284 doc: /* Take cdr N times on LIST, return the result. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1285 (Lisp_Object n, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1286 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1287 register int i, num;
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1288 CHECK_NUMBER (n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1289 num = XINT (n);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1290 for (i = 0; i < num && !NILP (list); i++)
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 QUIT;
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1293 CHECK_LIST_CONS (list, list);
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1294 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1295 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1296 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1297 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1298
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1299 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1300 doc: /* Return the Nth element of LIST.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1301 N counts from zero. If LIST is not that long, nil is returned. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1302 (Lisp_Object n, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1303 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1304 return Fcar (Fnthcdr (n, list));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1305 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1306
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1307 DEFUN ("elt", Felt, Selt, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1308 doc: /* Return element of SEQUENCE at index N. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1309 (register Lisp_Object sequence, Lisp_Object n)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1310 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1311 CHECK_NUMBER (n);
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1312 if (CONSP (sequence) || NILP (sequence))
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1313 return Fcar (Fnthcdr (n, sequence));
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1314
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1315 /* Faref signals a "not array" error, so check here. */
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1316 CHECK_ARRAY (sequence, Qsequencep);
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1317 return Faref (sequence, n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1318 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1319
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1320 DEFUN ("member", Fmember, Smember, 2, 2, 0,
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
1321 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1322 The value is actually the tail of LIST whose car is ELT. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1323 (register Lisp_Object elt, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1325 register Lisp_Object tail;
85330
0bc184c59770 * xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85114
diff changeset
1326 for (tail = list; CONSP (tail); tail = XCDR (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1327 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1328 register Lisp_Object tem;
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1329 CHECK_LIST_CONS (tail, list);
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1330 tem = XCAR (tail);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1331 if (! NILP (Fequal (elt, tem)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1332 return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1333 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1334 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1335 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1336 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1337
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1338 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
1339 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
73029
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1340 The value is actually the tail of LIST whose car is ELT. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1341 (register Lisp_Object elt, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1342 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1343 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1344 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1345 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1346 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1347
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1348 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1349 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1350 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1351
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1352 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1353 if (!CONSP (list) || EQ (XCAR (list), elt))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1354 break;
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1355
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1356 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1357 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1359
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1360 CHECK_LIST (list);
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1361 return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1362 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1363
73029
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1364 DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
1365 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'.
73029
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1366 The value is actually the tail of LIST whose car is ELT. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1367 (register Lisp_Object elt, Lisp_Object list)
73029
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1368 {
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1369 register Lisp_Object tail;
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1370
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1371 if (!FLOATP (elt))
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1372 return Fmemq (elt, list);
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1373
85330
0bc184c59770 * xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85114
diff changeset
1374 for (tail = list; CONSP (tail); tail = XCDR (tail))
73029
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1375 {
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1376 register Lisp_Object tem;
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1377 CHECK_LIST_CONS (tail, list);
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1378 tem = XCAR (tail);
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1379 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0))
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1380 return tail;
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1381 QUIT;
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1382 }
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1383 return Qnil;
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1384 }
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
1385
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1386 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1387 doc: /* Return non-nil if KEY is `eq' to the car of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1388 The value is actually the first element of LIST whose car is KEY.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1389 Elements of LIST that are not conses are ignored. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1390 (Lisp_Object key, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1391 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1392 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1393 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1394 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1395 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1396 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1397 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1398
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1399 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1400 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1401 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1402 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1403 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1404
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1405 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1406 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1407 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1408 && EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1409 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1410
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1411 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1412 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1413 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1414
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1415 return CAR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1416 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1417
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1418 /* Like Fassq but never report an error and do not allow quits.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1419 Use only on lists known never to be circular. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1420
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
1422 assq_no_quit (Lisp_Object key, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1423 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1424 while (CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1425 && (!CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1426 || !EQ (XCAR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1427 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1428
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1429 return CAR_SAFE (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1431
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1432 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1433 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1434 The value is actually the first element of LIST whose car equals KEY. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1435 (Lisp_Object key, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1436 {
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1437 Lisp_Object car;
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1438
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1439 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1440 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1441 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1442 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1443 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1444 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1445 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1446
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1447 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1448 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1449 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1450 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1451 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1452 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1453
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1454 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1455 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1456 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1457 && (car = XCAR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1458 EQ (car, key) || !NILP (Fequal (car, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1459 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1460
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1461 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1462 QUIT;
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
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1465 return CAR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1466 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467
90408
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1468 /* Like Fassoc but never report an error and do not allow quits.
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1469 Use only on lists known never to be circular. */
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1470
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1471 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
1472 assoc_no_quit (Lisp_Object key, Lisp_Object list)
90408
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1473 {
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1474 while (CONSP (list)
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1475 && (!CONSP (XCAR (list))
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1476 || (!EQ (XCAR (XCAR (list)), key)
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1477 && NILP (Fequal (XCAR (XCAR (list)), key)))))
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1478 list = XCDR (list);
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1479
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1480 return CONSP (list) ? XCAR (list) : Qnil;
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1481 }
cc49fe5026c6 (assoc_no_quit): New function.
Kenichi Handa <handa@m17n.org>
parents: 90384
diff changeset
1482
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1483 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1484 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1485 The value is actually the first element of LIST whose cdr is KEY. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1486 (register Lisp_Object key, Lisp_Object list)
211
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 while (1)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1489 {
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1490 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1491 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1492 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1493 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1494
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1495 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1496 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1497 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1498 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1499 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1500
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1501 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1502 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1503 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1504 && EQ (XCDR (XCAR (list)), key)))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1505 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1506
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1507 list = XCDR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1508 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1509 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1510
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1511 return CAR (list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1512 }
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1513
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1514 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1515 doc: /* Return non-nil if KEY is `equal' to the cdr of an element of LIST.
53115
988e1d16a971 (Fassq, Fassoc, Frassq, Frassoc): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53106
diff changeset
1516 The value is actually the first element of LIST whose cdr equals KEY. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1517 (Lisp_Object key, Lisp_Object list)
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1518 {
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1519 Lisp_Object cdr;
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1520
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1521 while (1)
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1522 {
26230
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;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1528
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1529 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1530 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1531 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1532 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1533 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1534 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1535
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1536 list = XCDR (list);
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1537 if (!CONSP (list)
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1538 || (CONSP (XCAR (list))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1539 && (cdr = XCDR (XCAR (list)),
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1540 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1541 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1542
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1543 list = XCDR (list);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1544 QUIT;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1545 }
26230
d44efc0b3243 (Fmemq, Fassq, Frassq, assq_no_quit, Fassoc)
Gerd Moellmann <gerd@gnu.org>
parents: 26088
diff changeset
1546
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1547 return CAR (list);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1548 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1550 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1551 doc: /* Delete by side effect any occurrences of ELT as a member of LIST.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1552 The modified LIST is returned. Comparison is done with `eq'.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1553 If the first member of LIST is ELT, there is no way to remove it by side effect;
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1554 therefore, write `(setq foo (delq element foo))'
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1555 to be sure of changing the value of `foo'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1556 (register Lisp_Object elt, Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1557 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1558 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1559 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1560
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1561 tail = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1562 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1563 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1564 {
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1565 CHECK_LIST_CONS (tail, list);
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1566 tem = XCAR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1567 if (EQ (elt, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1568 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1569 if (NILP (prev))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1570 list = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1571 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1572 Fsetcdr (prev, XCDR (tail));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1573 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1574 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1575 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1576 tail = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1577 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1578 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1579 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1580 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1581
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
1582 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1583 doc: /* Delete by side effect any occurrences of ELT as a member of SEQ.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1584 SEQ must be a list, a vector, or a string.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1585 The modified SEQ is returned. Comparison is done with `equal'.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1586 If SEQ is not a list, or the first member of SEQ is ELT, deleting it
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1587 is not a side effect; it is simply using a different sequence.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1588 Therefore, write `(setq foo (delete element foo))'
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1589 to be sure of changing the value of `foo'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1590 (Lisp_Object elt, Lisp_Object seq)
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1591 {
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1592 if (VECTORP (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1593 {
34961
d033c08f2ac6 (Flength): Remove unused variable `tail'.
Eli Zaretskii <eliz@gnu.org>
parents: 34722
diff changeset
1594 EMACS_INT i, n;
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1595
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1596 for (i = n = 0; i < ASIZE (seq); ++i)
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1597 if (NILP (Fequal (AREF (seq, i), elt)))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1598 ++n;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1599
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1600 if (n != ASIZE (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1601 {
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
1602 struct Lisp_Vector *p = allocate_vector (n);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1603
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1604 for (i = n = 0; i < ASIZE (seq); ++i)
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1605 if (NILP (Fequal (AREF (seq, i), elt)))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1606 p->contents[n++] = AREF (seq, i);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1607
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1608 XSETVECTOR (seq, p);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1609 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1610 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1611 else if (STRINGP (seq))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1612 {
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1613 EMACS_INT i, ibyte, nchars, nbytes, cbytes;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1614 int c;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1615
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1616 for (i = nchars = nbytes = ibyte = 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1617 i < SCHARS (seq);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1618 ++i, ibyte += cbytes)
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1619 {
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1620 if (STRING_MULTIBYTE (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1621 {
106185
f2cea199b0c4 * character.h (STRING_CHAR, STRING_CHAR_AND_LENGTH): Remove
Andreas Schwab <schwab@linux-m68k.org>
parents: 105959
diff changeset
1622 c = STRING_CHAR (SDATA (seq) + ibyte);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1623 cbytes = CHAR_BYTES (c);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1624 }
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1625 else
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1626 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1627 c = SREF (seq, i);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1628 cbytes = 1;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1629 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1630
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1631 if (!INTEGERP (elt) || c != XINT (elt))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1632 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1633 ++nchars;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1634 nbytes += cbytes;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1635 }
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1636 }
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1637
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1638 if (nchars != SCHARS (seq))
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1639 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1640 Lisp_Object tem;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1641
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1642 tem = make_uninit_multibyte_string (nchars, nbytes);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1643 if (!STRING_MULTIBYTE (seq))
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1644 STRING_SET_UNIBYTE (tem);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1645
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1646 for (i = nchars = nbytes = ibyte = 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1647 i < SCHARS (seq);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1648 ++i, ibyte += cbytes)
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1649 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1650 if (STRING_MULTIBYTE (seq))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1651 {
106185
f2cea199b0c4 * character.h (STRING_CHAR, STRING_CHAR_AND_LENGTH): Remove
Andreas Schwab <schwab@linux-m68k.org>
parents: 105959
diff changeset
1652 c = STRING_CHAR (SDATA (seq) + ibyte);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1653 cbytes = CHAR_BYTES (c);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1654 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1655 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1656 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
1657 c = SREF (seq, i);
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1658 cbytes = 1;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1659 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1660
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1661 if (!INTEGERP (elt) || c != XINT (elt))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1662 {
46425
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
1663 unsigned char *from = SDATA (seq) + ibyte;
2e674544b19a * fns.c (concat): Use SSET.
Ken Raeburn <raeburn@raeburn.org>
parents: 46379
diff changeset
1664 unsigned char *to = SDATA (tem) + nbytes;
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1665 EMACS_INT n;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1666
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1667 ++nchars;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1668 nbytes += cbytes;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1669
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1670 for (n = cbytes; n--; )
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1671 *to++ = *from++;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1672 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1673 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1674
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1675 seq = tem;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1676 }
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1677 }
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1678 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1679 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1680 Lisp_Object tail, prev;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1681
85330
0bc184c59770 * xfns.c (Fx_create_frame, Fx_display_list):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85114
diff changeset
1682 for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1683 {
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1684 CHECK_LIST_CONS (tail, seq);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1685
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1686 if (!NILP (Fequal (elt, XCAR (tail))))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1687 {
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1688 if (NILP (prev))
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1689 seq = XCDR (tail);
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1690 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1691 Fsetcdr (prev, XCDR (tail));
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1692 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1693 else
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1694 prev = tail;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1695 QUIT;
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1696 }
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1697 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
1698
30510
4a2abe231277 (Fdelete): Make it work on vectors and strings in addition to lists.
Gerd Moellmann <gerd@gnu.org>
parents: 30496
diff changeset
1699 return seq;
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1700 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1701
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1702 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1703 doc: /* Reverse LIST by modifying cdr pointers.
53106
b4b8c928aba2 (Freverse): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53090
diff changeset
1704 Return the reversed list. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1705 (Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1706 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1707 register Lisp_Object prev, tail, next;
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 (list)) return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1710 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1711 tail = list;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1712 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1713 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1714 QUIT;
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1715 CHECK_LIST_CONS (tail, list);
26596
f908261703d3 (Fnthcdr, Fnreverse): Inline cdr.
Dave Love <fx@gnu.org>
parents: 26256
diff changeset
1716 next = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1717 Fsetcdr (tail, prev);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1718 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719 tail = next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1720 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1721 return prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1722 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1723
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1724 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
53106
b4b8c928aba2 (Freverse): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53090
diff changeset
1725 doc: /* Reverse LIST, copying. Return the reversed list.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1726 See also the function `nreverse', which is used more often. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1727 (Lisp_Object list)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1728 {
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1729 Lisp_Object new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1730
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1731 for (new = Qnil; CONSP (list); list = XCDR (list))
49204
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1732 {
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1733 QUIT;
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1734 new = Fcons (XCAR (list), new);
0feef1a06875 (Freverse): Use QUIT.
Dave Love <fx@gnu.org>
parents: 49081
diff changeset
1735 }
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1736 CHECK_LIST_END (list, list);
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1737 return new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1738 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1739
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
1740 Lisp_Object merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1741
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1742 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1743 doc: /* Sort LIST, stably, comparing elements using PREDICATE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1744 Returns the sorted list. LIST is modified by side effects.
63602
d34f50416edf (Fsort): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 63173
diff changeset
1745 PREDICATE is called with two elements of LIST, and should return non-nil
65325
66bec6e31cea (Fsort): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 64774
diff changeset
1746 if the first element should sort before the second. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1747 (Lisp_Object list, Lisp_Object predicate)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1748 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1749 Lisp_Object front, back;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1750 register Lisp_Object len, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1751 struct gcpro gcpro1, gcpro2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1752 register int length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1753
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1754 front = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1755 len = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1756 length = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1757 if (length < 2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1758 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1759
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1760 XSETINT (len, (length / 2) - 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1761 tem = Fnthcdr (len, list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1762 back = Fcdr (tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1763 Fsetcdr (tem, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 GCPRO2 (front, back);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1766 front = Fsort (front, predicate);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1767 back = Fsort (back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1768 UNGCPRO;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1769 return merge (front, back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1770 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1771
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1772 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
1773 merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1774 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1775 Lisp_Object value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1776 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1777 Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1778 register Lisp_Object l1, l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1779 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1780
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1781 l1 = org_l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1782 l2 = org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1783 tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1784 value = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1785
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1786 /* It is sufficient to protect org_l1 and org_l2.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1787 When l1 and l2 are updated, we copy the new values
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1788 back into the org_ vars. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1789 GCPRO4 (org_l1, org_l2, pred, value);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1790
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1793 if (NILP (l1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1794 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1795 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1796 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1797 return l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1798 Fsetcdr (tail, l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1799 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1800 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1801 if (NILP (l2))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1802 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1803 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1804 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1805 return l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1806 Fsetcdr (tail, l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1807 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1808 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1809 tem = call2 (pred, Fcar (l2), Fcar (l1));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1810 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1811 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1812 tem = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1813 l1 = Fcdr (l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1814 org_l1 = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1815 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1816 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1817 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1818 tem = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1819 l2 = Fcdr (l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1820 org_l2 = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1821 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1822 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1823 value = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1824 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1825 Fsetcdr (tail, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1826 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1827 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1828 }
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1829
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1830
61723
afe4f19c3436 (Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents: 61687
diff changeset
1831 /* This does not check for quits. That is safe since it must terminate. */
afe4f19c3436 (Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents: 61687
diff changeset
1832
afe4f19c3436 (Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents: 61687
diff changeset
1833 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
58239
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1834 doc: /* Extract a value from a property list.
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1835 PLIST is a property list, which is a list of the form
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1836 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
61723
afe4f19c3436 (Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents: 61687
diff changeset
1837 corresponding to the given PROP, or nil if PROP is not one of the
afe4f19c3436 (Fplist_get): Replace by Fsafe_plist_get.
Kim F. Storm <storm@cua.dk>
parents: 61687
diff changeset
1838 properties on the list. This function never signals an error. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1839 (Lisp_Object plist, Lisp_Object prop)
58239
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1840 {
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1841 Lisp_Object tail, halftail;
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1842
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1843 /* halftail is used to detect circular lists. */
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1844 tail = halftail = plist;
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1845 while (CONSP (tail) && CONSP (XCDR (tail)))
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1846 {
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1847 if (EQ (prop, XCAR (tail)))
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1848 return XCAR (XCDR (tail));
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1849
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1850 tail = XCDR (XCDR (tail));
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1851 halftail = XCDR (halftail);
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1852 if (EQ (tail, halftail))
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1853 break;
105937
88b92b3656ae (Fplist_get): Merge the active and the uncommented code.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105885
diff changeset
1854
88b92b3656ae (Fplist_get): Merge the active and the uncommented code.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105885
diff changeset
1855 #if 0 /* Unsafe version. */
88b92b3656ae (Fplist_get): Merge the active and the uncommented code.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105885
diff changeset
1856 /* This function can be called asynchronously
88b92b3656ae (Fplist_get): Merge the active and the uncommented code.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105885
diff changeset
1857 (setup_coding_system). Don't QUIT in that case. */
88b92b3656ae (Fplist_get): Merge the active and the uncommented code.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105885
diff changeset
1858 if (!interrupt_input_blocked)
88b92b3656ae (Fplist_get): Merge the active and the uncommented code.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105885
diff changeset
1859 QUIT;
88b92b3656ae (Fplist_get): Merge the active and the uncommented code.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105885
diff changeset
1860 #endif
58239
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1861 }
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1862
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1863 return Qnil;
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1864 }
6c9552cf734a (Fsafe_plist_get): New defun.
Kim F. Storm <storm@cua.dk>
parents: 57988
diff changeset
1865
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1866 DEFUN ("get", Fget, Sget, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1867 doc: /* Return the value of SYMBOL's PROPNAME property.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1868 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1869 (Lisp_Object symbol, Lisp_Object propname)
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1870 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1871 CHECK_SYMBOL (symbol);
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1872 return Fplist_get (XSYMBOL (symbol)->plist, propname);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1873 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1874
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1875 DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1876 doc: /* Change value in PLIST of PROP to VAL.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1877 PLIST is a property list, which is a list of the form
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1878 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1879 If PROP is already a property on the list, its value is set to VAL,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1880 otherwise the new PROP VAL pair is added. The new plist is returned;
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1881 use `(setq x (plist-put x prop val))' to be sure to use the new value.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1882 The PLIST is modified by side effects. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1883 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1884 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1885 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1886 Lisp_Object newcell;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1887 prev = Qnil;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1888 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
1889 tail = XCDR (XCDR (tail)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1890 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1891 if (EQ (prop, XCAR (tail)))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1892 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1893 Fsetcar (XCDR (tail), val);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1894 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1895 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
1896
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1897 prev = tail;
37279
c706f3e5efe0 (Fplist_get, Fplist_put): Add QUITs.
Gerd Moellmann <gerd@gnu.org>
parents: 37208
diff changeset
1898 QUIT;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1899 }
78824
c33d8980019c (Fplist_put): Preserve uneven tail data.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 78260
diff changeset
1900 newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1901 if (NILP (prev))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1902 return newcell;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1903 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
1904 Fsetcdr (XCDR (prev), newcell);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1905 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1906 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1907
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1908 DEFUN ("put", Fput, Sput, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1909 doc: /* Store SYMBOL's PROPNAME property with value VALUE.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1910 It can be retrieved with `(get SYMBOL PROPNAME)'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1911 (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1912 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
1913 CHECK_SYMBOL (symbol);
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1914 XSYMBOL (symbol)->plist
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1915 = 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
1916 return value;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1917 }
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1918
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1919 DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1920 doc: /* Extract a value from a property list, comparing with `equal'.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1921 PLIST is a property list, which is a list of the form
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1922 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1923 corresponding to the given PROP, or nil if PROP is not
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1924 one of the properties on the list. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1925 (Lisp_Object plist, Lisp_Object prop)
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1926 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1927 Lisp_Object tail;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
1928
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1929 for (tail = plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1930 CONSP (tail) && CONSP (XCDR (tail));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1931 tail = XCDR (XCDR (tail)))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1932 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1933 if (! NILP (Fequal (prop, XCAR (tail))))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1934 return XCAR (XCDR (tail));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1935
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1936 QUIT;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1937 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1938
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
1939 CHECK_LIST_END (tail, prop);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
1940
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1941 return Qnil;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1942 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1943
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1944 DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1945 doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1946 PLIST is a property list, which is a list of the form
44219
dfaa607f640f (Flax_plist_put): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 44159
diff changeset
1947 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects.
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1948 If PROP is already a property on the list, its value is set to VAL,
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1949 otherwise the new PROP VAL pair is added. The new plist is returned;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1950 use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1951 The PLIST is modified by side effects. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1952 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val)
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1953 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1954 register Lisp_Object tail, prev;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1955 Lisp_Object newcell;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1956 prev = Qnil;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1957 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1958 tail = XCDR (XCDR (tail)))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1959 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1960 if (! NILP (Fequal (prop, XCAR (tail))))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1961 {
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1962 Fsetcar (XCDR (tail), val);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1963 return plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1964 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
1965
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1966 prev = tail;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1967 QUIT;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1968 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1969 newcell = Fcons (prop, Fcons (val, Qnil));
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1970 if (NILP (prev))
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1971 return newcell;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1972 else
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1973 Fsetcdr (XCDR (prev), newcell);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1974 return plist;
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1975 }
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
1976
54987
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1977 DEFUN ("eql", Feql, Seql, 2, 2, 0,
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1978 doc: /* Return t if the two args are the same Lisp object.
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1979 Floating-point numbers of equal value are `eql', but they may not be `eq'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1980 (Lisp_Object obj1, Lisp_Object obj2)
54987
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1981 {
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1982 if (FLOATP (obj1))
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1983 return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil;
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1984 else
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1985 return EQ (obj1, obj2) ? Qt : Qnil;
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1986 }
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
1987
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1988 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1989 doc: /* Return t if two Lisp objects have similar structure and contents.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1990 They must have the same data type.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1991 Conses are compared by comparing the cars and the cdrs.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1992 Vectors and strings are compared element by element.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1993 Numbers are compared by value, but integers cannot equal floats.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
1994 (Use `=' if you want integers and floats to be able to be equal.)
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1995 Symbols must match exactly. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
1996 (register Lisp_Object o1, Lisp_Object o2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1997 {
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
1998 return internal_equal (o1, o2, 0, 0) ? Qt : Qnil;
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1999 }
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2000
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2001 DEFUN ("equal-including-properties", Fequal_including_properties, Sequal_including_properties, 2, 2, 0,
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2002 doc: /* Return t if two Lisp objects have similar structure and contents.
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2003 This is like `equal' except that it compares the text properties
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2004 of strings. (`equal' ignores text properties.) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2005 (register Lisp_Object o1, Lisp_Object o2)
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2006 {
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2007 return internal_equal (o1, o2, 0, 1) ? Qt : Qnil;
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2008 }
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2009
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2010 /* DEPTH is current depth of recursion. Signal an error if it
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2011 gets too deep.
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2012 PROPS, if non-nil, means compare string text properties too. */
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2013
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2014 static int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
2015 internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int props)
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2016 {
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2017 if (depth > 200)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
2018 error ("Stack overflow in equal");
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2019
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2020 tail_recurse:
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2021 QUIT;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2022 if (EQ (o1, o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2023 return 1;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2024 if (XTYPE (o1) != XTYPE (o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2025 return 0;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2026
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2027 switch (XTYPE (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2028 {
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2029 case Lisp_Float:
53393
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2030 {
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2031 double d1, d2;
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2032
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2033 d1 = extract_float (o1);
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2034 d2 = extract_float (o2);
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2035 /* If d is a NaN, then d != d. Two NaNs should be `equal' even
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2036 though they are not =. */
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2037 return d1 == d2 || (d1 != d1 && d2 != d2);
6658b72a5f99 (internal_equal): Return t for two NaN arguments.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53259
diff changeset
2038 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2039
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2040 case Lisp_Cons:
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2041 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2042 return 0;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2043 o1 = XCDR (o1);
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2044 o2 = XCDR (o2);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2045 goto tail_recurse;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2046
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2047 case Lisp_Misc:
11240
2642924d2d21 (internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2048 if (XMISCTYPE (o1) != XMISCTYPE (o2))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2049 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2050 if (OVERLAYP (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2051 {
25149
ee483f870bde (internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents: 25094
diff changeset
2052 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2053 depth + 1, props)
25149
ee483f870bde (internal_equal): Fix overlay comparison.
Richard M. Stallman <rms@gnu.org>
parents: 25094
diff changeset
2054 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
65713
ad24f42046b1 * xlwmenu.c (find_next_selectable):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 65325
diff changeset
2055 depth + 1, props))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2056 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2057 o1 = XOVERLAY (o1)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2058 o2 = XOVERLAY (o2)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2059 goto tail_recurse;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2060 }
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2061 if (MARKERP (o1))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2062 {
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2063 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
2064 && (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
2065 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2066 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2067 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2068
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2069 case Lisp_Vectorlike:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2070 {
53159
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2071 register int i;
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2072 EMACS_INT size = ASIZE (o1);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2073 /* 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
2074 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
2075 same size. */
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2076 if (ASIZE (o2) != size)
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2077 return 0;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2078 /* Boolvectors are compared much like strings. */
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2079 if (BOOL_VECTOR_P (o1))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2080 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2081 int size_in_chars
55161
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
2082 = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
2083 / BOOL_VECTOR_BITS_PER_CHAR);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2084
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2085 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
2086 return 0;
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
2087 if (memcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data,
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
2088 size_in_chars))
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2089 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2090 return 1;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2091 }
20776
219fdecc30d3 (internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents: 20712
diff changeset
2092 if (WINDOW_CONFIGURATIONP (o1))
21021
7be2384fabdc (internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents: 20992
diff changeset
2093 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
2094
94929
b9ffe341b5c8 (internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents: 93072
diff changeset
2095 /* Aside from them, only true vectors, char-tables, compiled
b9ffe341b5c8 (internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents: 93072
diff changeset
2096 functions, and fonts (font-spec, font-entity, font-ojbect)
b9ffe341b5c8 (internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents: 93072
diff changeset
2097 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
2098 if (size & PSEUDOVECTOR_FLAG)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2099 {
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
2100 if (!(size & (PVEC_COMPILED
94929
b9ffe341b5c8 (internal_equal): Handle PREV_FONT.
Kenichi Handa <handa@m17n.org>
parents: 93072
diff changeset
2101 | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2102 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2103 size &= PSEUDOVECTOR_SIZE_MASK;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2104 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2105 for (i = 0; i < size; i++)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2106 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2107 Lisp_Object v1, v2;
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2108 v1 = AREF (o1, i);
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2109 v2 = AREF (o2, i);
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2110 if (!internal_equal (v1, v2, depth + 1, props))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2111 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2112 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2113 return 1;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2114 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2115 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2116
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
2117 case Lisp_String:
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2118 if (SCHARS (o1) != SCHARS (o2))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2119 return 0;
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2120 if (SBYTES (o1) != SBYTES (o2))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2121 return 0;
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
2122 if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1)))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2123 return 0;
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2124 if (props && !compare_string_intervals (o1, o2))
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
2125 return 0;
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
2126 return 1;
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2127
105885
8103235103a7 Let integers use up 2 tags to give them one extra bit and double their range.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105877
diff changeset
2128 default:
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2129 break;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2130 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2131
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
2132 return 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2133 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2134
18613
614b916ff5bf Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents: 18531
diff changeset
2135
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2136 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2137 doc: /* Store each element of ARRAY with ITEM.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2138 ARRAY is a vector, string, char-table, or bool-vector. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2139 (Lisp_Object array, Lisp_Object item)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2140 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2141 register EMACS_INT size, index;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2142 int charval;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2143
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2144 if (VECTORP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2145 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2146 register Lisp_Object *p = XVECTOR (array)->contents;
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2147 size = ASIZE (array);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2148 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2149 p[index] = item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2150 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2151 else if (CHAR_TABLE_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2152 {
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
2153 int i;
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
2154
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
2155 for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
2156 XCHAR_TABLE (array)->contents[i] = item;
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
2157 XCHAR_TABLE (array)->defalt = item;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2158 }
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2159 else if (STRINGP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2160 {
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2161 register unsigned char *p = SDATA (array);
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2162 CHECK_NUMBER (item);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2163 charval = XINT (item);
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2164 size = SCHARS (array);
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2165 if (STRING_MULTIBYTE (array))
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2166 {
26856
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
2167 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
2168 int len = CHAR_STRING (charval, str);
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2169 EMACS_INT size_byte = SBYTES (array);
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2170 unsigned char *p1 = p, *endp = p + size_byte;
23453
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2171 int i;
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2172
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2173 if (size != size_byte)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2174 while (p1 < endp)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2175 {
108881
5582106cddf0 Remove obsolete pre-unicode2 macros.
Juanma Barranquero <lekktu@gmail.com>
parents: 108114
diff changeset
2176 int this_len = BYTES_BY_CHAR_HEAD (*p1);
23453
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2177 if (len != this_len)
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2178 error ("Attempt to change byte length of a string");
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2179 p1 += this_len;
fa66133ad026 (Ffillarray): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 23424
diff changeset
2180 }
23424
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2181 for (i = 0; i < size_byte; i++)
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2182 *p++ = str[i % len];
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2183 }
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2184 else
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2185 for (index = 0; index < size; index++)
982f97638a8e (clear_string_char_byte_cache): New function.
Kenichi Handa <handa@m17n.org>
parents: 23208
diff changeset
2186 p[index] = charval;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2187 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2188 else if (BOOL_VECTOR_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2189 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2190 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
2191 int size_in_chars
55161
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
2192 = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
2193 / BOOL_VECTOR_BITS_PER_CHAR);
13140
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 charval = (! NILP (item) ? -1 : 0);
53159
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2196 for (index = 0; index < size_in_chars - 1; index++)
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2197 p[index] = charval;
53159
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2198 if (index < size_in_chars)
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2199 {
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2200 /* Mask out bits beyond the vector size. */
55161
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
2201 if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
2202 charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
53159
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2203 p[index] = charval;
e929f6d1593b (internal_equal) <case Lisp_Vectorlike>: Declare size as
Andreas Schwab <schwab@suse.de>
parents: 53138
diff changeset
2204 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2205 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2206 else
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
2207 wrong_type_argument (Qarrayp, array);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2208 return array;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2209 }
52075
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2210
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2211 DEFUN ("clear-string", Fclear_string, Sclear_string,
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2212 1, 1, 0,
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2213 doc: /* Clear the contents of STRING.
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2214 This makes STRING unibyte and may change its length. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2215 (Lisp_Object string)
52075
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2216 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2217 EMACS_INT len;
56358
97e94a98c666 (Fclear_string): Signal an error if STRING is not a string.
John Paul Wallington <jpw@pobox.com>
parents: 56241
diff changeset
2218 CHECK_STRING (string);
56364
78e8df7d1ad8 (Fclear_string): Correct previous change.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56361
diff changeset
2219 len = SBYTES (string);
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
2220 memset (SDATA (string), 0, len);
52075
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2221 STRING_SET_CHARS (string, len);
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2222 STRING_SET_UNIBYTE (string);
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2223 return Qnil;
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
2224 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2225
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2226 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2227 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
2228 nconc2 (Lisp_Object s1, Lisp_Object s2)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2229 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2230 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2231 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2232 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2233 return Fnconc (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2234 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2235
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2236 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2237 doc: /* Concatenate any number of lists by altering them.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
2238 Only the last argument is not altered, and need not be a list.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
2239 usage: (nconc &rest LISTS) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2240 (int nargs, Lisp_Object *args)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2241 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2242 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2243 register Lisp_Object tail, tem, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2244
31533
3898245f639a (concat, Fsubstring, internal_equal, Fnconc): Avoid some
Gerd Moellmann <gerd@gnu.org>
parents: 30760
diff changeset
2245 val = tail = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2246
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2247 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2248 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2249 tem = args[argnum];
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2250 if (NILP (tem)) continue;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2251
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2252 if (NILP (val))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2253 val = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2254
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2255 if (argnum + 1 == nargs) break;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2256
71833
1b88c4bbacbc (Flength, Felt, Ffillarray): Remove loop around wrong_type_argument.
Kim F. Storm <storm@cua.dk>
parents: 70939
diff changeset
2257 CHECK_LIST_CONS (tem, tem);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2258
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2259 while (CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2260 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2261 tail = tem;
46221
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
2262 tem = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2263 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2264 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2265
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2266 tem = args[argnum + 1];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2267 Fsetcdr (tail, tem);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2268 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2269 args[argnum + 1] = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2270 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2271
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2272 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2273 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2274
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2275 /* 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
2276 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
2277 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
2278 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
2279
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2280 static void
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2281 mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2282 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2283 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2284 Lisp_Object dummy;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2285 register EMACS_INT i;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2286 struct gcpro gcpro1, gcpro2, gcpro3;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2287
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2288 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2289 {
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2290 /* Don't let vals contain any garbage when GC happens. */
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2291 for (i = 0; i < leni; i++)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2292 vals[i] = Qnil;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2293
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2294 GCPRO3 (dummy, fn, seq);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2295 gcpro1.var = vals;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2296 gcpro1.nvars = leni;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2297 }
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2298 else
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2299 GCPRO2 (fn, seq);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2300 /* We need not explicitly protect `tail' because it is used only on lists, and
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2301 1) lists are not relocated and 2) the list is marked via `seq' so will not
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2302 be freed */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2303
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2304 if (VECTORP (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2305 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2306 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2307 {
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2308 dummy = call1 (fn, AREF (seq, i));
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2309 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2310 vals[i] = dummy;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2311 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2312 }
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2313 else if (BOOL_VECTOR_P (seq))
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2314 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2315 for (i = 0; i < leni; i++)
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2316 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2317 int byte;
55161
beac72c0215f (Fcopy_sequence, concat, internal_equal, Ffillarray, mapcar1): Use
Andreas Schwab <schwab@suse.de>
parents: 54994
diff changeset
2318 byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
2319 dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil;
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2320 dummy = call1 (fn, dummy);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2321 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2322 vals[i] = dummy;
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2323 }
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2324 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2325 else if (STRINGP (seq))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2326 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2327 EMACS_INT i_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2328
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2329 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
2330 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2331 int c;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2332 EMACS_INT i_before = i;
20712
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2333
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2334 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
2335 XSETFASTINT (dummy, c);
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2336 dummy = call1 (fn, dummy);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2337 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2338 vals[i_before] = dummy;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2339 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2340 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2341 else /* Must be a list, since Flength did not get an error */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2342 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2343 tail = seq;
62950
c698dd8981bd (mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents: 62674
diff changeset
2344 for (i = 0; i < leni && CONSP (tail); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2345 {
62950
c698dd8981bd (mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents: 62674
diff changeset
2346 dummy = call1 (fn, XCAR (tail));
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2347 if (vals)
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2348 vals[i] = dummy;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25619
diff changeset
2349 tail = XCDR (tail);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2350 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2351 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2352
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2355
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2356 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2357 doc: /* Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.
39956
b394d7876697 (Fmapconcat): Fix typo in a doc string.
Pavel Janík <Pavel@Janik.cz>
parents: 39899
diff changeset
2358 In between each pair of results, stick in SEPARATOR. Thus, " " as
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2359 SEPARATOR results in spaces between the values returned by FUNCTION.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2360 SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2361 (Lisp_Object function, Lisp_Object sequence, Lisp_Object separator)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2362 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2363 Lisp_Object len;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2364 register EMACS_INT leni;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2365 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2366 register Lisp_Object *args;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2367 register EMACS_INT i;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2368 struct gcpro gcpro1;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2369 Lisp_Object ret;
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2370 USE_SAFE_ALLOCA;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2371
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2372 len = Flength (sequence);
89624
4e86a45294f5 (Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents: 89615
diff changeset
2373 if (CHAR_TABLE_P (sequence))
4e86a45294f5 (Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents: 89615
diff changeset
2374 wrong_type_argument (Qlistp, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2375 leni = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2376 nargs = leni + leni - 1;
81283
f5adf7770714 (Fmapconcat): Use empty_unibyte_string.
Juanma Barranquero <lekktu@gmail.com>
parents: 77908
diff changeset
2377 if (nargs < 0) return empty_unibyte_string;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2378
56203
2bb92448ff94 (Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents: 56199
diff changeset
2379 SAFE_ALLOCA_LISP (args, nargs);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2380
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2381 GCPRO1 (separator);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2382 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2383 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2384
62950
c698dd8981bd (mapcar1): Maybe exit loop if original sequence was modified.
Kim F. Storm <storm@cua.dk>
parents: 62674
diff changeset
2385 for (i = leni - 1; i > 0; i--)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2386 args[i + i] = args[i];
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2387
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2388 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
2389 args[i] = separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2390
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2391 ret = Fconcat (nargs, args);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
2392 SAFE_FREE ();
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2393
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2394 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2395 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2396
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2397 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2398 doc: /* Apply FUNCTION to each element of SEQUENCE, and make a list of the results.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2399 The result is a list just as long as SEQUENCE.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2400 SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2401 (Lisp_Object function, Lisp_Object sequence)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2402 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2403 register Lisp_Object len;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2404 register EMACS_INT leni;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2405 register Lisp_Object *args;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2406 Lisp_Object ret;
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2407 USE_SAFE_ALLOCA;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2408
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2409 len = Flength (sequence);
89624
4e86a45294f5 (Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents: 89615
diff changeset
2410 if (CHAR_TABLE_P (sequence))
4e86a45294f5 (Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents: 89615
diff changeset
2411 wrong_type_argument (Qlistp, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2412 leni = XFASTINT (len);
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2413
56203
2bb92448ff94 (Fmapconcat, Fmapcar): Use new SAFE_ALLOCA_LISP and
Kim F. Storm <storm@cua.dk>
parents: 56199
diff changeset
2414 SAFE_ALLOCA_LISP (args, leni);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2415
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2416 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2417
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2418 ret = Flist (leni, args);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
2419 SAFE_FREE ();
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2420
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2421 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2422 }
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2423
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2424 DEFUN ("mapc", Fmapc, Smapc, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2425 doc: /* Apply FUNCTION to each element of SEQUENCE for side effects only.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2426 Unlike `mapcar', don't accumulate the results. Return SEQUENCE.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2427 SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2428 (Lisp_Object function, Lisp_Object sequence)
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2429 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2430 register EMACS_INT leni;
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2431
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2432 leni = XFASTINT (Flength (sequence));
89624
4e86a45294f5 (Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents: 89615
diff changeset
2433 if (CHAR_TABLE_P (sequence))
4e86a45294f5 (Fmapconcat): Signal an error if SEQUENCE is a char table.
Kenichi Handa <handa@m17n.org>
parents: 89615
diff changeset
2434 wrong_type_argument (Qlistp, sequence);
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2435 mapcar1 (leni, 0, function, sequence);
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2436
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2437 return sequence;
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
2438 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2439
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2440 /* 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
2441 to redefined it.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2442
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2443 Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2444
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2445 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
2446 do_yes_or_no_p (Lisp_Object prompt)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2447 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2448 return call1 (intern ("yes-or-no-p"), prompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2449 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2450
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2451 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2452
112380
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2453 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2454 doc: /* Ask user a yes-or-no question. Return t if answer is yes.
112380
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2455 PROMPT is the string to display to ask the question. It should end in
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2456 a space; `yes-or-no-p' adds \"(yes or no) \" to it.
112165
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112160
diff changeset
2457
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112160
diff changeset
2458 The user must confirm the answer with RET, and can edit it until it
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112160
diff changeset
2459 has been confirmed.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2460
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2461 Under a windowing system a dialog box will be used if `last-nonmenu-event'
112380
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2462 is nil, and `use-dialog-box' is non-nil. */)
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2463 (Lisp_Object prompt)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2464 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2465 register Lisp_Object ans;
112380
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2466 Lisp_Object args[2];
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2467 struct gcpro gcpro1;
112380
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2468
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2469 CHECK_STRING (prompt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2470
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
2471 #ifdef HAVE_MENUS
83370
5272862a4865 Fix crashes in xdialog_show (and other places) with xterm-mouse-mode.
Karoly Lorentey <lorentey@elte.hu>
parents: 65325
diff changeset
2472 if (FRAME_WINDOW_P (SELECTED_FRAME ())
5272862a4865 Fix crashes in xdialog_show (and other places) with xterm-mouse-mode.
Karoly Lorentey <lorentey@elte.hu>
parents: 65325
diff changeset
2473 && (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
2474 && 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
2475 && 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
2476 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2477 Lisp_Object pane, menu, obj;
35336
002c02db42d3 Call redisplay_preserve_echo_area with additional arg.
Gerd Moellmann <gerd@gnu.org>
parents: 34961
diff changeset
2478 redisplay_preserve_echo_area (4);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2479 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
2480 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
2481 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
2482 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
2483 menu = Fcons (prompt, pane);
62674
100b8f001349 (Fyes_or_no_p, Fy_or_n_p): Call Fx_popup_dialog with
Nick Roberts <nickrob@snap.net.nz>
parents: 62139
diff changeset
2484 obj = Fx_popup_dialog (Qt, menu, Qnil);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2485 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
2486 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
2487 }
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
2488 #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
2489
112380
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2490 args[0] = prompt;
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2491 args[1] = build_string ("(yes or no) ");
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2492 prompt = Fconcat (2, args);
aa1e27e3a554 Revert changes adding format args to yes-or-no-p and y-or-n-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112364
diff changeset
2493
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2494 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
2495
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2496 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2497 {
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
2498 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
2499 Qyes_or_no_p_history, Qnil,
70939
10be917a42fa (Fyes_or_no_p): Fread_from_minibuffer now takes only seven args.
Luc Teirlinck <teirllm@auburn.edu>
parents: 69957
diff changeset
2500 Qnil));
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2501 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes"))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2502 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2503 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2504 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2505 }
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2506 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no"))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2507 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2508 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2509 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2510 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2511
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2512 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2513 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2514 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
2515 Fsleep_for (make_number (2), Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2516 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2517 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2518
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2519 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2520 doc: /* Return list of 1 minute, 5 minute and 15 minute load averages.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2521
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2522 Each of the three load averages is multiplied by 100, then converted
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2523 to integer.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2524
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2525 When USE-FLOATS is non-nil, floats will be used instead of integers.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2526 These floats are not multiplied by 100.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2527
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2528 If the 5-minute or 15-minute load averages are not available, return a
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2529 shortened list, containing only those averages which are available.
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2530
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2531 An error is thrown if the load average can't be obtained. In some
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2532 cases making it work would require Emacs being installed setuid or
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2533 setgid so that it can read kernel information, and that usually isn't
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2534 advisable. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2535 (Lisp_Object use_floats)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2536 {
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2537 double load_ave[3];
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2538 int loads = getloadavg (load_ave, 3);
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2539 Lisp_Object ret = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2540
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2541 if (loads < 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2542 error ("load-average not implemented for this operating system");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2543
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2544 while (loads-- > 0)
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2545 {
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2546 Lisp_Object load = (NILP (use_floats) ?
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2547 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
2548 : make_float (load_ave[loads]));
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2549 ret = Fcons (load, ret);
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2550 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2551
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2552 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2553 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2554
112364
42e22c4f06b7 Move all DEFVAR'd globals into a structure -- threading infrastructure
Tom Tromey <tromey@redhat.com>
parents: 112330
diff changeset
2555 Lisp_Object Qsubfeatures;
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2556
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2557 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0,
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
2558 doc: /* Return t if FEATURE is present in this Emacs.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2559
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2560 Use this to conditionalize execution of lisp code based on the
73686
d2a970fd4273 (Ffeaturep, syms_of_fns): Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents: 73049
diff changeset
2561 presence or absence of Emacs or environment extensions.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2562 Use `provide' to declare that a feature is available. This function
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2563 looks at the value of the variable `features'. The optional argument
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2564 SUBFEATURE can be used to check a specific subfeature of FEATURE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2565 (Lisp_Object feature, Lisp_Object subfeature)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2566 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2567 register Lisp_Object tem;
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2568 CHECK_SYMBOL (feature);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2569 tem = Fmemq (feature, Vfeatures);
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2570 if (!NILP (tem) && !NILP (subfeature))
44066
d0bef01f3cb3 (Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents: 41006
diff changeset
2571 tem = Fmember (subfeature, Fget (feature, Qsubfeatures));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2572 return (NILP (tem)) ? Qnil : Qt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2573 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2574
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2575 DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2576 doc: /* Announce that FEATURE is a feature of the current Emacs.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2577 The optional argument SUBFEATURES should be a list of symbols listing
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2578 particular subfeatures supported in this version of FEATURE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2579 (Lisp_Object feature, Lisp_Object subfeatures)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2580 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2581 register Lisp_Object tem;
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2582 CHECK_SYMBOL (feature);
44066
d0bef01f3cb3 (Ffeaturep): Allow subfeature to be a list (test using
Kim F. Storm <storm@cua.dk>
parents: 41006
diff changeset
2583 CHECK_LIST (subfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2584 if (!NILP (Vautoload_queue))
67809
a4fcb45bffec (Fprovide): Store (0 . OFEATURES) in Vautoload_queue.
Richard M. Stallman <rms@gnu.org>
parents: 67497
diff changeset
2585 Vautoload_queue = Fcons (Fcons (make_number (0), Vfeatures),
a4fcb45bffec (Fprovide): Store (0 . OFEATURES) in Vautoload_queue.
Richard M. Stallman <rms@gnu.org>
parents: 67497
diff changeset
2586 Vautoload_queue);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2587 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2588 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2589 Vfeatures = Fcons (feature, Vfeatures);
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2590 if (!NILP (subfeatures))
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2591 Fput (feature, Qsubfeatures, subfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2592 LOADHIST_ATTACH (Fcons (Qprovide, feature));
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2593
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2594 /* Run any load-hooks for this file. */
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2595 tem = Fassq (feature, Vafter_load_alist);
46221
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
2596 if (CONSP (tem))
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
2597 Fprogn (XCDR (tem));
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
2598
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2599 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2600 }
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2601
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2602 /* `require' and its subroutines. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2603
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2604 /* List of features currently being require'd, innermost first. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2605
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2606 Lisp_Object require_nesting_list;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2607
40550
56075abda301 (require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents: 40474
diff changeset
2608 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
2609 require_unwind (Lisp_Object old_value)
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2610 {
40550
56075abda301 (require_unwind): Return Lisp_Object.
Gerd Moellmann <gerd@gnu.org>
parents: 40474
diff changeset
2611 return require_nesting_list = old_value;
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2612 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2613
23733
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2614 DEFUN ("require", Frequire, Srequire, 1, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2615 doc: /* If feature FEATURE is not loaded, load it from FILENAME.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2616 If FEATURE is not a member of the list `features', then the feature
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2617 is not loaded; so load the file FILENAME.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2618 If FILENAME is omitted, the printname of FEATURE is used as the file name,
52766
ada153c6900b (Frequire): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 52401
diff changeset
2619 and `load' will try to load this name appended with the suffix `.elc' or
ada153c6900b (Frequire): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents: 52401
diff changeset
2620 `.el', in that order. The name without appended suffix will not be used.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2621 If the optional third argument NOERROR is non-nil,
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2622 then return nil if the file is not found instead of signaling an error.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2623 Normally the return value is FEATURE.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2624 The normal messages at start and end of loading FILENAME are suppressed. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2625 (Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2626 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2627 register Lisp_Object tem;
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2628 struct gcpro gcpro1, gcpro2;
67497
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2629 int from_file = load_in_progress;
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2630
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2631 CHECK_SYMBOL (feature);
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2632
59490
dc3b1db0bed2 (Frequire): Record in load-history unconditionally.
Richard M. Stallman <rms@gnu.org>
parents: 59146
diff changeset
2633 /* Record the presence of `require' in this file
61417
93f7c57762e3 (Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents: 59630
diff changeset
2634 even if the feature specified is already loaded.
93f7c57762e3 (Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents: 59630
diff changeset
2635 But not more than once in any file,
67497
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2636 and not when we aren't loading or reading from a file. */
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2637 if (!from_file)
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2638 for (tem = Vcurrent_load_list; CONSP (tem); tem = XCDR (tem))
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2639 if (NILP (XCDR (tem)) && STRINGP (XCAR (tem)))
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2640 from_file = 1;
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2641
6f5564740da6 (Frequire): Treat evaluating from a source file
Richard M. Stallman <rms@gnu.org>
parents: 66236
diff changeset
2642 if (from_file)
61417
93f7c57762e3 (Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents: 59630
diff changeset
2643 {
93f7c57762e3 (Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents: 59630
diff changeset
2644 tem = Fcons (Qrequire, feature);
93f7c57762e3 (Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents: 59630
diff changeset
2645 if (NILP (Fmember (tem, Vcurrent_load_list)))
93f7c57762e3 (Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents: 59630
diff changeset
2646 LOADHIST_ATTACH (tem);
93f7c57762e3 (Vloads_in_progress): Add extern.
Richard M. Stallman <rms@gnu.org>
parents: 59630
diff changeset
2647 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2648 tem = Fmemq (feature, Vfeatures);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2649
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2650 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2651 {
46293
1fb8f75062c6 Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents: 46221
diff changeset
2652 int count = SPECPDL_INDEX ();
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2653 int nesting = 0;
45037
8fe017cea042 (Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents: 44760
diff changeset
2654
45039
ed0ad59e4ec7 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 45037
diff changeset
2655 /* This is to make sure that loadup.el gives a clear picture
ed0ad59e4ec7 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 45037
diff changeset
2656 of what files are preloaded and when. */
45037
8fe017cea042 (Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents: 44760
diff changeset
2657 if (! NILP (Vpurify_flag))
8fe017cea042 (Frequire): Error if called while preparing to dump.
Richard M. Stallman <rms@gnu.org>
parents: 44760
diff changeset
2658 error ("(require %s) while preparing to dump",
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2659 SDATA (SYMBOL_NAME (feature)));
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
2660
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2661 /* A certain amount of recursive `require' is legitimate,
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2662 but if we require the same feature recursively 3 times,
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2663 signal an error. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2664 tem = require_nesting_list;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2665 while (! NILP (tem))
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2666 {
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2667 if (! NILP (Fequal (feature, XCAR (tem))))
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2668 nesting++;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2669 tem = XCDR (tem);
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2670 }
48567
ecf43ac20827 fns.c (Frequire): Change nesting allowance from 2 to 3 to cause more
Steven Tamm <steventamm@mac.com>
parents: 48337
diff changeset
2671 if (nesting > 3)
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2672 error ("Recursive `require' for feature `%s'",
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2673 SDATA (SYMBOL_NAME (feature)));
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2674
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2675 /* Update the list for any nested `require's that occur. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2676 record_unwind_protect (require_unwind, require_nesting_list);
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2677 require_nesting_list = Fcons (feature, require_nesting_list);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2678
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2679 /* Value saved here is to be restored into Vautoload_queue */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2680 record_unwind_protect (un_autoload, Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2681 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2682
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2683 /* Load the file. */
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2684 GCPRO2 (feature, filename);
37208
34075f64de15 (Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents: 36890
diff changeset
2685 tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename,
34075f64de15 (Frequire): Doc fix. Rename parameter FILE_NAME to
Gerd Moellmann <gerd@gnu.org>
parents: 36890
diff changeset
2686 noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2687 UNGCPRO;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2688
23733
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2689 /* If load failed entirely, return nil. */
e963fc8ca03f (Frequire): New arg NOERROR.
Richard M. Stallman <rms@gnu.org>
parents: 23690
diff changeset
2690 if (NILP (tem))
24016
43344f47a865 (Frequire): Don't fail to unbind bindings.
Richard M. Stallman <rms@gnu.org>
parents: 23927
diff changeset
2691 return unbind_to (count, Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2692
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2693 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2694 if (NILP (tem))
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2695 error ("Required feature `%s' was not provided",
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
2696 SDATA (SYMBOL_NAME (feature)));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2697
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2698 /* Once loading finishes, don't undo it. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2699 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2700 feature = unbind_to (count, feature);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2701 }
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
2702
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2703 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2704 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2705
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2706 /* Primitives for work of the "widget" library.
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2707 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
2708 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
2709 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
2710 bottleneck of Widget operation. Here is their translation to C,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2711 for the sole reason of efficiency. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2712
29953
dad7b11391a3 (Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29809
diff changeset
2713 DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2714 doc: /* Return non-nil if PLIST has the property PROP.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2715 PLIST is a property list, which is a list of the form
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2716 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2717 Unlike `plist-get', this allows you to distinguish between a missing
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2718 property and a property with the value nil.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2719 The value is actually the tail of PLIST whose car is PROP. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2720 (Lisp_Object plist, Lisp_Object prop)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2721 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2722 while (CONSP (plist) && !EQ (XCAR (plist), prop))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2723 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2724 QUIT;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2725 plist = XCDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2726 plist = CDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2727 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2728 return plist;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2729 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2730
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2731 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2732 doc: /* In WIDGET, set PROPERTY to VALUE.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2733 The value can later be retrieved with `widget-get'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2734 (Lisp_Object widget, Lisp_Object property, Lisp_Object value)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2735 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2736 CHECK_CONS (widget);
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39968
diff changeset
2737 XSETCDR (widget, Fplist_put (XCDR (widget), property, value));
23207
302eccdcb73c (Fwidget_put): Return VALUE instead of garbage.
Karl Heuer <kwzh@gnu.org>
parents: 23152
diff changeset
2738 return value;
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2739 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2740
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2741 DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2742 doc: /* In WIDGET, get the value of PROPERTY.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2743 The value could either be specified when the widget was created, or
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2744 later with `widget-put'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2745 (Lisp_Object widget, Lisp_Object property)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2746 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2747 Lisp_Object tmp;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2748
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2749 while (1)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2750 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2751 if (NILP (widget))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2752 return Qnil;
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
2753 CHECK_CONS (widget);
29953
dad7b11391a3 (Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29809
diff changeset
2754 tmp = Fplist_member (XCDR (widget), property);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2755 if (CONSP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2756 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2757 tmp = XCDR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2758 return CAR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2759 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2760 tmp = XCAR (widget);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2761 if (NILP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2762 return Qnil;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2763 widget = Fget (tmp, Qwidget_type);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2764 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2765 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2766
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2767 DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2768 doc: /* Apply the value of WIDGET's PROPERTY to the widget itself.
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
2769 ARGS are passed as extra arguments to the function.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
2770 usage: (widget-apply WIDGET PROPERTY &rest ARGS) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2771 (int nargs, Lisp_Object *args)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2772 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2773 /* This function can GC. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2774 Lisp_Object newargs[3];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2775 struct gcpro gcpro1, gcpro2;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2776 Lisp_Object result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2777
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2778 newargs[0] = Fwidget_get (args[0], args[1]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2779 newargs[1] = args[0];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2780 newargs[2] = Flist (nargs - 2, args + 2);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2781 GCPRO2 (newargs[0], newargs[2]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2782 result = Fapply (3, newargs);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2783 UNGCPRO;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2784 return result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2785 }
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2786
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2787 #ifdef HAVE_LANGINFO_CODESET
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2788 #include <langinfo.h>
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2789 #endif
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2790
51976
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
2791 DEFUN ("locale-info", Flocale_info, Slocale_info, 1, 1, 0,
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
2792 doc: /* Access locale data ITEM for the current C locale, if available.
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
2793 ITEM should be one of the following:
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2794
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
2795 `codeset', returning the character set as a string (locale item CODESET);
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2796
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
2797 `days', returning a 7-element vector of day names (locale items DAY_n);
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2798
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
2799 `months', returning a 12-element vector of month names (locale items MON_n);
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2800
51976
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
2801 `paper', returning a list (WIDTH HEIGHT) for the default paper size,
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
2802 both measured in milimeters (locale items PAPER_WIDTH, PAPER_HEIGHT).
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2803
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2804 If the system can't provide such information through a call to
51976
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
2805 `nl_langinfo', or if ITEM isn't from the list above, return nil.
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2806
49798
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
2807 See also Info node `(libc)Locales'.
48a58e6b11cc (Flanginfo): Doc fix.
Dave Love <fx@gnu.org>
parents: 49674
diff changeset
2808
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2809 The data read from the system are decoded using `locale-coding-system'. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2810 (Lisp_Object item)
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2811 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2812 char *str = NULL;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2813 #ifdef HAVE_LANGINFO_CODESET
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2814 Lisp_Object val;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2815 if (EQ (item, Qcodeset))
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2816 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2817 str = nl_langinfo (CODESET);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2818 return build_string (str);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2819 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2820 #ifdef DAY_1
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2821 else if (EQ (item, Qdays)) /* e.g. for calendar-day-name-array */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2822 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2823 Lisp_Object v = Fmake_vector (make_number (7), Qnil);
103095
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2824 const int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2825 int i;
103095
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2826 struct gcpro gcpro1;
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2827 GCPRO1 (v);
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2828 synchronize_system_time_locale ();
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2829 for (i = 0; i < 7; i++)
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2830 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2831 str = nl_langinfo (days[i]);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2832 val = make_unibyte_string (str, strlen (str));
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2833 /* Fixme: Is this coding system necessarily right, even if
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2834 it is consistent with CODESET? If not, what to do? */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2835 Faset (v, make_number (i),
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2836 code_convert_string_norecord (val, Vlocale_coding_system,
49915
95557d4395b0 (string_to_multibyte): Remove unused var i.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 49815
diff changeset
2837 0));
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2838 }
103095
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2839 UNGCPRO;
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2840 return v;
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2841 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2842 #endif /* DAY_1 */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2843 #ifdef MON_1
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2844 else if (EQ (item, Qmonths)) /* e.g. for calendar-month-name-array */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2845 {
103095
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2846 Lisp_Object v = Fmake_vector (make_number (12), Qnil);
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2847 const int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2848 MON_8, MON_9, MON_10, MON_11, MON_12};
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2849 int i;
103095
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2850 struct gcpro gcpro1;
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2851 GCPRO1 (v);
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2852 synchronize_system_time_locale ();
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2853 for (i = 0; i < 12; i++)
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2854 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2855 str = nl_langinfo (months[i]);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2856 val = make_unibyte_string (str, strlen (str));
103095
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2857 Faset (v, make_number (i),
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2858 code_convert_string_norecord (val, Vlocale_coding_system, 0));
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2859 }
103095
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2860 UNGCPRO;
65cc22e2c624 * fns.c (Flocale_info): Protect vector from GC during decoding.
Andreas Schwab <schwab@linux-m68k.org>
parents: 101587
diff changeset
2861 return v;
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2862 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2863 #endif /* MON_1 */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2864 /* LC_PAPER stuff isn't defined as accessible in glibc as of 2.3.1,
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2865 but is in the locale files. This could be used by ps-print. */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2866 #ifdef PAPER_WIDTH
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2867 else if (EQ (item, Qpaper))
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2868 {
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2869 return list2 (make_number (nl_langinfo (PAPER_WIDTH)),
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2870 make_number (nl_langinfo (PAPER_HEIGHT)));
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2871 }
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2872 #endif /* PAPER_WIDTH */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2873 #endif /* HAVE_LANGINFO_CODESET*/
51397
6b7e048da8be Doc fixes.
Dave Love <fx@gnu.org>
parents: 51038
diff changeset
2874 return Qnil;
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
2875 }
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2876
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
2877 /* base64 encode/decode functions (RFC 2045).
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2878 Based on code from GNU recode. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2879
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2880 #define MIME_LINE_LENGTH 76
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2881
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2882 #define IS_ASCII(Character) \
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2883 ((Character) < 128)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2884 #define IS_BASE64(Character) \
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2885 (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
2886 #define IS_BASE64_IGNORABLE(Character) \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2887 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2888 || (Character) == '\f' || (Character) == '\r')
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2889
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2890 /* 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
2891 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
2892 process. */
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2893 #define READ_QUADRUPLET_BYTE(retval) \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2894 do \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2895 { \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2896 if (i == length) \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2897 { \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2898 if (nchars_return) \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2899 *nchars_return = nchars; \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2900 return (retval); \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2901 } \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2902 c = from[i++]; \
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
2903 } \
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
2904 while (IS_BASE64_IGNORABLE (c))
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2905
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2906 /* Table of characters coding the 64 values. */
105959
ba3ffbd9c422 * process.c (ifflag_def): Make flag_sym constant.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105937
diff changeset
2907 static const char base64_value_to_char[64] =
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2908 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2909 '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
2910 '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
2911 '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
2912 '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
2913 '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
2914 '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
2915 '8', '9', '+', '/' /* 60-63 */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2916 };
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2917
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2918 /* Table of base64 values for first 128 characters. */
105959
ba3ffbd9c422 * process.c (ifflag_def): Make flag_sym constant.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105937
diff changeset
2919 static const short base64_char_to_value[128] =
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2920 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2921 -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
2922 -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
2923 -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
2924 -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
2925 -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
2926 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
2927 -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
2928 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
2929 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
2930 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
2931 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
2932 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
2933 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
2934 };
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2935
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2936 /* 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
2937 get transformed into four base64 characters.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2938
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2939 .--------. .--------. .--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2940 |aaaaaabb| |bbbbcccc| |ccdddddd|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2941 `--------' `--------' `--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2942 6 2 4 4 2 6
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2943 .--------+--------+--------+--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2944 |00aaaaaa|00bbbbbb|00cccccc|00dddddd|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2945 `--------+--------+--------+--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2946
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2947 .--------+--------+--------+--------.
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2948 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD|
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2949 `--------+--------+--------+--------'
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2950
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2951 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
2952 base64 characters. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2953
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2954
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2955 static EMACS_INT base64_encode_1 (const char *, char *, EMACS_INT, int, int);
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2956 static EMACS_INT base64_decode_1 (const char *, char *, EMACS_INT, int,
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2957 EMACS_INT *);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2958
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2959 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
2960 2, 3, "r",
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2961 doc: /* Base64-encode the region between BEG and END.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2962 Return the length of the encoded text.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
2963 Optional third argument NO-LINE-BREAK means do not break long lines
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2964 into shorter lines. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
2965 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2966 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2967 char *encoded;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2968 EMACS_INT allength, length;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2969 EMACS_INT ibeg, iend, encoded_length;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
2970 EMACS_INT old_pos = PT;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2971 USE_SAFE_ALLOCA;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2972
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2973 validate_region (&beg, &end);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2974
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2975 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2976 iend = CHAR_TO_BYTE (XFASTINT (end));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2977 move_gap_both (XFASTINT (beg), ibeg);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2978
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2979 /* 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
2980 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
2981 characters, and then we round up. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2982 length = iend - ibeg;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2983 allength = length + length/3 + 1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2984 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
2985
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
2986 SAFE_ALLOCA (encoded, char *, allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2987 encoded_length = base64_encode_1 (BYTE_POS_ADDR (ibeg), encoded, length,
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
2988 NILP (no_line_break),
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
2989 !NILP (current_buffer->enable_multibyte_characters));
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2990 if (encoded_length > allength)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2991 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
2992
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
2993 if (encoded_length < 0)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
2994 {
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
2995 /* The encoding wasn't possible. */
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
2996 SAFE_FREE ();
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
2997 error ("Multibyte character in data for base64 encoding");
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
2998 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
2999
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3000 /* 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
3001 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
3002 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
3003 insert (encoded, encoded_length);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
3004 SAFE_FREE ();
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3005 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
3006
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3007 /* 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
3008 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
3009 if (old_pos >= XFASTINT (end))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3010 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
3011 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
3012 old_pos = XFASTINT (beg);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3013 SET_PT (old_pos);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3014
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3015 /* 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
3016 return make_number (encoded_length);
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
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3019 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
3020 1, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3021 doc: /* Base64-encode STRING and return the result.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3022 Optional second argument NO-LINE-BREAK means do not break long lines
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3023 into shorter lines. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
3024 (Lisp_Object string, Lisp_Object no_line_break)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3025 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3026 EMACS_INT allength, length, encoded_length;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3027 char *encoded;
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3028 Lisp_Object encoded_string;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
3029 USE_SAFE_ALLOCA;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3030
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3031 CHECK_STRING (string);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3032
24437
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3033 /* 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
3034 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
3035 characters, and then we round up. */
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3036 length = SBYTES (string);
24437
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3037 allength = length + length/3 + 1;
8a9d8919ebe8 (Fbase64_encode_string): Allocate sufficient memory for
Kenichi Handa <handa@m17n.org>
parents: 24377
diff changeset
3038 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
3039
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3040 /* We need to allocate enough room for decoding the text. */
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
3041 SAFE_ALLOCA (encoded, char *, allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3042
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3043 encoded_length = base64_encode_1 (SDATA (string),
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3044 encoded, length, NILP (no_line_break),
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3045 STRING_MULTIBYTE (string));
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3046 if (encoded_length > allength)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3047 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3048
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3049 if (encoded_length < 0)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3050 {
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3051 /* The encoding wasn't possible. */
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
3052 SAFE_FREE ();
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
3053 error ("Multibyte character in data for base64 encoding");
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3054 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3055
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3056 encoded_string = make_unibyte_string (encoded, encoded_length);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
3057 SAFE_FREE ();
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3058
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3059 return encoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3060 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3061
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3062 static EMACS_INT
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3063 base64_encode_1 (const char *from, char *to, EMACS_INT length,
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3064 int line_break, int multibyte)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3065 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3066 int counter = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3067 EMACS_INT i = 0;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3068 char *e = to;
31865
dd9aa7db6710 (base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents: 31842
diff changeset
3069 int c;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3070 unsigned int value;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3071 int bytes;
23208
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 while (i < length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3074 {
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3075 if (multibyte)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3076 {
106185
f2cea199b0c4 * character.h (STRING_CHAR, STRING_CHAR_AND_LENGTH): Remove
Andreas Schwab <schwab@linux-m68k.org>
parents: 105959
diff changeset
3077 c = STRING_CHAR_AND_LENGTH (from + i, bytes);
89046
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3078 if (CHAR_BYTE8_P (c))
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3079 c = CHAR_TO_BYTE8 (c);
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3080 else if (c >= 256)
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3081 return -1;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3082 i += bytes;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3083 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3084 else
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3085 c = from[i++];
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3086
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3087 /* Wrap line every 76 characters. */
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 if (line_break)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3090 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3091 if (counter < MIME_LINE_LENGTH / 4)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3092 counter++;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3093 else
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3094 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3095 *e++ = '\n';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3096 counter = 1;
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 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3099
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3100 /* Process first byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3101
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3102 *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
3103 value = (0x03 & c) << 4;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3104
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3105 /* Process second byte of a triplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3106
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3107 if (i == length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3108 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3109 *e++ = base64_value_to_char[value];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3110 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3111 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3112 break;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3113 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3114
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3115 if (multibyte)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3116 {
106185
f2cea199b0c4 * character.h (STRING_CHAR, STRING_CHAR_AND_LENGTH): Remove
Andreas Schwab <schwab@linux-m68k.org>
parents: 105959
diff changeset
3117 c = STRING_CHAR_AND_LENGTH (from + i, bytes);
89046
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3118 if (CHAR_BYTE8_P (c))
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3119 c = CHAR_TO_BYTE8 (c);
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3120 else if (c >= 256)
31865
dd9aa7db6710 (base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents: 31842
diff changeset
3121 return -1;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3122 i += bytes;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3123 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3124 else
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3125 c = from[i++];
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3126
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3127 *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
3128 value = (0x0f & c) << 2;
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 /* Process third byte of a triplet. */
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 if (i == length)
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 *e++ = base64_value_to_char[value];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3135 *e++ = '=';
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3136 break;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3137 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3138
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3139 if (multibyte)
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3140 {
106185
f2cea199b0c4 * character.h (STRING_CHAR, STRING_CHAR_AND_LENGTH): Remove
Andreas Schwab <schwab@linux-m68k.org>
parents: 105959
diff changeset
3141 c = STRING_CHAR_AND_LENGTH (from + i, bytes);
89046
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3142 if (CHAR_BYTE8_P (c))
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3143 c = CHAR_TO_BYTE8 (c);
7a6ebd6b0c38 (base64_encode_1): Handle eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 89039
diff changeset
3144 else if (c >= 256)
31865
dd9aa7db6710 (base64_encode_1): Fix last change.
Dave Love <fx@gnu.org>
parents: 31842
diff changeset
3145 return -1;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3146 i += bytes;
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3147 }
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3148 else
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3149 c = from[i++];
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3150
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3151 *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
3152 *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
3153 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3154
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3155 return e - to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3156 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3157
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 DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3160 2, 2, "r",
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3161 doc: /* Base64-decode the region between BEG and END.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
3162 Return the length of the decoded text.
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3163 If the region can't be decoded, signal an error and don't modify the buffer. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
3164 (Lisp_Object beg, Lisp_Object end)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3165 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3166 EMACS_INT ibeg, iend, length, allength;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3167 char *decoded;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3168 EMACS_INT old_pos = PT;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3169 EMACS_INT decoded_length;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3170 EMACS_INT inserted_chars;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3171 int multibyte = !NILP (current_buffer->enable_multibyte_characters);
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
3172 USE_SAFE_ALLOCA;
23208
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 validate_region (&beg, &end);
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 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3177 iend = CHAR_TO_BYTE (XFASTINT (end));
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 length = iend - ibeg;
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3180
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3181 /* We need to allocate enough room for decoding the text. If we are
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3182 working on a multibyte buffer, each decoded code may occupy at
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3183 most two bytes. */
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3184 allength = multibyte ? length * 2 : length;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
3185 SAFE_ALLOCA (decoded, char *, allength);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3186
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3187 move_gap_both (XFASTINT (beg), ibeg);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3188 decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length,
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3189 multibyte, &inserted_chars);
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3190 if (decoded_length > allength)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3191 abort ();
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3192
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3193 if (decoded_length < 0)
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3194 {
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3195 /* The decoding wasn't possible. */
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
3196 SAFE_FREE ();
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
3197 error ("Invalid base64 data");
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3198 }
23208
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 /* 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
3201 and delete the old. (Insert first in order to preserve markers.) */
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3202 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg);
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3203 insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0);
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
3204 SAFE_FREE ();
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
3205
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3206 /* Delete the original text. */
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3207 del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars,
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3208 iend + decoded_length, 1);
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 /* 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
3211 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
3212 if (old_pos >= XFASTINT (end))
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3213 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
3214 else if (old_pos > XFASTINT (beg))
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3215 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
3216 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
3217
23536
0154f51c56d8 (Fbase64_decode_region): Pay attention to the byte
Kenichi Handa <handa@m17n.org>
parents: 23453
diff changeset
3218 return make_number (inserted_chars);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3219 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3220
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3221 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
3222 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3223 doc: /* Base64-decode STRING and return the result. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
3224 (Lisp_Object string)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3225 {
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3226 char *decoded;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3227 EMACS_INT length, decoded_length;
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3228 Lisp_Object decoded_string;
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
3229 USE_SAFE_ALLOCA;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3230
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3231 CHECK_STRING (string);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3232
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3233 length = SBYTES (string);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3234 /* We need to allocate enough room for decoding the text. */
56195
3204d2175b6a * fns.c (string_make_multibyte, string_to_multibyte)
Kim F. Storm <storm@cua.dk>
parents: 56147
diff changeset
3235 SAFE_ALLOCA (decoded, char *, length);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3236
32753
401f661f11d4 2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 32351
diff changeset
3237 /* The decoded result should be unibyte. */
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
3238 decoded_length = base64_decode_1 (SDATA (string), decoded, length,
32753
401f661f11d4 2000-10-22 15:07:47 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents: 32351
diff changeset
3239 0, NULL);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3240 if (decoded_length > length)
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3241 abort ();
28493
9ffea423a7b0 (Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents: 28481
diff changeset
3242 else if (decoded_length >= 0)
29010
f62cfa81b0c4 (concat): Handle 8-bit characters correctly.
Kenichi Handa <handa@m17n.org>
parents: 28965
diff changeset
3243 decoded_string = make_unibyte_string (decoded, decoded_length);
28493
9ffea423a7b0 (Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents: 28481
diff changeset
3244 else
23901
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3245 decoded_string = Qnil;
974c8a7b79e8 (Fbase64_decode_region, Fbase64_decode_string):
Karl Heuer <kwzh@gnu.org>
parents: 23877
diff changeset
3246
57726
66e97a54985f Fix SAFE_FREE calls. Replace SAFE_FREE_LISP calls.
Kim F. Storm <storm@cua.dk>
parents: 57482
diff changeset
3247 SAFE_FREE ();
28493
9ffea423a7b0 (Fbase64_decode_region, Fbase64_decode_string): Signal
Gerd Moellmann <gerd@gnu.org>
parents: 28481
diff changeset
3248 if (!STRINGP (decoded_string))
32234
811419e9e769 (Fbase64_encode_region, Fbase64_encode_string)
Dave Love <fx@gnu.org>
parents: 31865
diff changeset
3249 error ("Invalid base64 data");
23690
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3250
5149f79d6dfd (MAX_ALLOCA): New macro.
Eli Zaretskii <eliz@gnu.org>
parents: 23595
diff changeset
3251 return decoded_string;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3252 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3253
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3254 /* Base64-decode the data at FROM of LENGHT bytes into TO. If
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3255 MULTIBYTE is nonzero, the decoded result should be in multibyte
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3256 form. If NCHARS_RETRUN is not NULL, store the number of produced
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3257 characters in *NCHARS_RETURN. */
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3258
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3259 static EMACS_INT
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3260 base64_decode_1 (const char *from, char *to, EMACS_INT length,
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3261 int multibyte, EMACS_INT *nchars_return)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3262 {
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3263 EMACS_INT i = 0; /* Used inside READ_QUADRUPLET_BYTE */
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3264 char *e = to;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3265 unsigned char c;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3266 unsigned long value;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
3267 EMACS_INT nchars = 0;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3268
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3269 while (1)
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3270 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3271 /* Process first byte of a quadruplet. */
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3272
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3273 READ_QUADRUPLET_BYTE (e-to);
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 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3276 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3277 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
3278
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3279 /* Process second byte of a quadruplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3280
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3281 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3282
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3283 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3284 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3285 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
3286
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3287 c = (unsigned char) (value >> 16);
89039
2383f41c7b8a (base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 88980
diff changeset
3288 if (multibyte && c >= 128)
2383f41c7b8a (base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 88980
diff changeset
3289 e += BYTE8_STRING (c, e);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3290 else
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3291 *e++ = c;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3292 nchars++;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3293
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3294 /* Process third byte of a quadruplet. */
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3295
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3296 READ_QUADRUPLET_BYTE (-1);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3297
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3298 if (c == '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3299 {
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3300 READ_QUADRUPLET_BYTE (-1);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3301
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3302 if (c != '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3303 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3304 continue;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3305 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3306
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3307 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3308 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3309 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
3310
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3311 c = (unsigned char) (0xff & value >> 8);
89039
2383f41c7b8a (base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 88980
diff changeset
3312 if (multibyte && c >= 128)
2383f41c7b8a (base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 88980
diff changeset
3313 e += BYTE8_STRING (c, e);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3314 else
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3315 *e++ = c;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3316 nchars++;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3317
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3318 /* Process fourth byte of a quadruplet. */
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3319
24275
e30a84ad7aa0 (IS_BASE64_IGNORABLE, READ_QUADRUPLET_BYTE): New macros.
Paul Fisher <rao@gnu.org>
parents: 24255
diff changeset
3320 READ_QUADRUPLET_BYTE (-1);
23208
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 if (c == '=')
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3323 continue;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3324
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3325 if (!IS_BASE64 (c))
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3326 return -1;
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3327 value |= base64_char_to_value[c];
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3328
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3329 c = (unsigned char) (0xff & value);
89039
2383f41c7b8a (base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 88980
diff changeset
3330 if (multibyte && c >= 128)
2383f41c7b8a (base64_decode_1): Insert eight-bit chars correctly.
Kenichi Handa <handa@m17n.org>
parents: 88980
diff changeset
3331 e += BYTE8_STRING (c, e);
32351
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3332 else
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3333 *e++ = c;
4ecfc281cce1 (READ_QUADRUPLET_BYTE): Set *NCHARS_RETURN before
Kenichi Handa <handa@m17n.org>
parents: 32234
diff changeset
3334 nchars++;
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3335 }
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
3336 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3337
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3338
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3339
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3340 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3341 ***** *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3342 ***** Hash Tables *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3343 ***** *****
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3344 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3345
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3346 /* Implemented by gerd@gnu.org. This hash table implementation was
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3347 inspired by CMUCL hash tables. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3348
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3349 /* Ideas:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3350
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3351 1. For small tables, association lists are probably faster than
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3352 hash tables because they have lower overhead.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3353
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3354 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
3355 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
3356 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
3357 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
3358 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
3359
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3360
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3361 /* 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
3362
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
3363 struct Lisp_Hash_Table *weak_hash_tables;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3364
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3365 /* Various symbols. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3366
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3367 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue;
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
3368 Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
3369 Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3370
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3371 /* Function prototypes. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3372
109100
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3373 static struct Lisp_Hash_Table *check_hash_table (Lisp_Object);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3374 static int get_key_arg (Lisp_Object, int, Lisp_Object *, char *);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3375 static void maybe_resize_hash_table (struct Lisp_Hash_Table *);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3376 static int cmpfn_eql (struct Lisp_Hash_Table *, Lisp_Object, unsigned,
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3377 Lisp_Object, unsigned);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3378 static int cmpfn_equal (struct Lisp_Hash_Table *, Lisp_Object, unsigned,
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3379 Lisp_Object, unsigned);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3380 static int cmpfn_user_defined (struct Lisp_Hash_Table *, Lisp_Object,
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3381 unsigned, Lisp_Object, unsigned);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3382 static unsigned hashfn_eq (struct Lisp_Hash_Table *, Lisp_Object);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3383 static unsigned hashfn_eql (struct Lisp_Hash_Table *, Lisp_Object);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3384 static unsigned hashfn_equal (struct Lisp_Hash_Table *, Lisp_Object);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3385 static unsigned hashfn_user_defined (struct Lisp_Hash_Table *,
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3386 Lisp_Object);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3387 static unsigned sxhash_string (unsigned char *, int);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3388 static unsigned sxhash_list (Lisp_Object, int);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3389 static unsigned sxhash_vector (Lisp_Object, int);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3390 static unsigned sxhash_bool_vector (Lisp_Object);
2bc9a0c04c87 Remove __P and P_ from .c and .m files and definition of P_
Jan D <jan.h.d@swipnet.se>
parents: 108946
diff changeset
3391 static int sweep_weak_table (struct Lisp_Hash_Table *, int);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3392
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
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 Utilities
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3399 /* 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
3400 Lisp_Hash_Table. Otherwise, signal an error. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3401
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3402 static struct Lisp_Hash_Table *
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3403 check_hash_table (Lisp_Object obj)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3404 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
3405 CHECK_HASH_TABLE (obj);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3406 return XHASH_TABLE (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3407 }
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3410 /* 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
3411 number. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3412
29979
6fe8f444b6a3 (next_almost_prime): Make it externally visible.
Gerd Moellmann <gerd@gnu.org>
parents: 29953
diff changeset
3413 int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3414 next_almost_prime (int n)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3415 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3416 if (n % 2 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3417 n += 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3418 if (n % 3 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3419 n += 2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3420 if (n % 7 == 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3421 n += 4;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3422 return n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3423 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3424
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3425
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3426 /* 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
3427 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
3428 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
3429 -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
3430 a DEFUN parameter list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3431
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3432 static int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3433 get_key_arg (Lisp_Object key, int nargs, Lisp_Object *args, char *used)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3434 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3435 int i;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3436
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3437 for (i = 0; i < nargs - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3438 if (!used[i] && EQ (args[i], key))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3439 break;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3440
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3441 if (i >= nargs - 1)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3442 i = -1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3443 else
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 used[i++] = 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3446 used[i] = 1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3447 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3448
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3449 return i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3450 }
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3453 /* 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
3454 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
3455 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
3456
28481
3caab3235bc1 (larger_vector): Make externally visible.
Gerd Moellmann <gerd@gnu.org>
parents: 28222
diff changeset
3457 Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3458 larger_vector (Lisp_Object vec, int new_size, Lisp_Object init)
25005
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 struct Lisp_Vector *v;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3461 int i, old_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3462
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3463 xassert (VECTORP (vec));
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
3464 old_size = ASIZE (vec);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3465 xassert (new_size >= old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3466
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
3467 v = allocate_vector (new_size);
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
3468 memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3469 for (i = old_size; i < new_size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3470 v->contents[i] = init;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3471 XSETVECTOR (vec, v);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3472 return vec;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3473 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3474
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 Low-level Functions
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3478 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3479
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3480 /* 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
3481 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
3482 KEY2 are the same. */
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
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3485 cmpfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3486 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3487 return (FLOATP (key1)
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3488 && FLOATP (key2)
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
3489 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2));
25005
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
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 /* 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
3494 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
3495 KEY2 are the same. */
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 static int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3498 cmpfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3499 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3500 return hash1 == hash2 && !NILP (Fequal (key1, key2));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3501 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3502
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3503
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3504 /* 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
3505 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
3506 if KEY1 and KEY2 are the same. */
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 static int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3509 cmpfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key1, unsigned int hash1, Lisp_Object key2, unsigned int hash2)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3510 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3511 if (hash1 == hash2)
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 Lisp_Object args[3];
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3514
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3515 args[0] = h->user_cmp_function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3516 args[1] = key1;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3517 args[2] = key2;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3518 return !NILP (Ffuncall (3, args));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3519 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3520 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3521 return 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3522 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3523
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3524
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3525 /* 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
3526 `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
3527 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3528
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3529 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3530 hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3531 {
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
3532 unsigned hash = XUINT (key) ^ XTYPE (key);
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
3533 xassert ((hash & ~INTMASK) == 0);
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
3534 return hash;
25005
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 /* 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
3539 `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
3540 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3541
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3542 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3543 hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3544 {
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
3545 unsigned hash;
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
3546 if (FLOATP (key))
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
3547 hash = sxhash (key, 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3548 else
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
3549 hash = XUINT (key) ^ XTYPE (key);
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
3550 xassert ((hash & ~INTMASK) == 0);
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
3551 return hash;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3552 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3553
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 /* 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
3556 `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
3557 in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3558
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3559 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3560 hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3561 {
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
3562 unsigned hash = sxhash (key, 0);
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
3563 xassert ((hash & ~INTMASK) == 0);
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
3564 return hash;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3565 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3566
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3567
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3568 /* 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
3569 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
3570 guaranteed to fit in a Lisp integer. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3571
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3572 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3573 hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
25005
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 Lisp_Object args[2], hash;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3576
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3577 args[0] = h->user_hash_function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3578 args[1] = key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3579 hash = Ffuncall (2, args);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3580 if (!INTEGERP (hash))
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
3581 signal_error ("Invalid hash code returned from user-supplied hash function", hash);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3582 return XUINT (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3583 }
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3586 /* Create and initialize a new hash table.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3587
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3588 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
3589 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
3590 `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
3591 test and hash functions USER_TEST and USER_HASH.
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3592
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
3593 Give the table initial capacity SIZE, SIZE >= 0, an integer.
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3594
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3595 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
3596 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
3597 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
3598 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
3599 REHASH_SIZE.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3600
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3601 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
3602 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
3603 (table size) is >= REHASH_THRESHOLD.
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3604
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3605 WEAK specifies the weakness of the table. If non-nil, it must be
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
3606 one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3607
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3608 Lisp_Object
109364
89a16701cde1 Convert old-style definitions
Andreas Schwab <schwab@linux-m68k.org>
parents: 109310
diff changeset
3609 make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
89a16701cde1 Convert old-style definitions
Andreas Schwab <schwab@linux-m68k.org>
parents: 109310
diff changeset
3610 Lisp_Object rehash_threshold, Lisp_Object weak,
89a16701cde1 Convert old-style definitions
Andreas Schwab <schwab@linux-m68k.org>
parents: 109310
diff changeset
3611 Lisp_Object user_test, Lisp_Object user_hash)
25005
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 struct Lisp_Hash_Table *h;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3614 Lisp_Object table;
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
3615 int index_size, i, sz;
25005
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 /* Preconditions. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3618 xassert (SYMBOLP (test));
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
3619 xassert (INTEGERP (size) && XINT (size) >= 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3620 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3621 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3622 xassert (FLOATP (rehash_threshold)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3623 && XFLOATINT (rehash_threshold) > 0
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3624 && XFLOATINT (rehash_threshold) <= 1.0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3625
30602
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
3626 if (XFASTINT (size) == 0)
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
3627 size = make_number (1);
4f195cb24338 Replace `illegal' with `invalid'.
Gerd Moellmann <gerd@gnu.org>
parents: 30597
diff changeset
3628
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
3629 /* Allocate a table and initialize it. */
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
3630 h = allocate_hash_table ();
25005
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 /* Initialize hash table slots. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3633 sz = XFASTINT (size);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3634
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3635 h->test = test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3636 if (EQ (test, Qeql))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3637 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3638 h->cmpfn = cmpfn_eql;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3639 h->hashfn = hashfn_eql;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3640 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3641 else if (EQ (test, Qeq))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3642 {
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3643 h->cmpfn = NULL;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3644 h->hashfn = hashfn_eq;
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 else if (EQ (test, Qequal))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3647 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3648 h->cmpfn = cmpfn_equal;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3649 h->hashfn = hashfn_equal;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3650 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3651 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3652 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3653 h->user_cmp_function = user_test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3654 h->user_hash_function = user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3655 h->cmpfn = cmpfn_user_defined;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3656 h->hashfn = hashfn_user_defined;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3657 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3658
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3659 h->weak = weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3660 h->rehash_threshold = rehash_threshold;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3661 h->rehash_size = rehash_size;
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
3662 h->count = 0;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3663 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
3664 h->hash = Fmake_vector (size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3665 h->next = Fmake_vector (size, Qnil);
29809
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
3666 /* Cast to int here avoids losing with gcc 2.95 on Tru64/Alpha... */
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
3667 index_size = next_almost_prime ((int) (sz / XFLOATINT (rehash_threshold)));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3668 h->index = Fmake_vector (make_number (index_size), Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3669
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3670 /* Set up the free list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3671 for (i = 0; i < sz - 1; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3672 HASH_NEXT (h, i) = make_number (i + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3673 h->next_free = make_number (0);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3674
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3675 XSET_HASH_TABLE (table, h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3676 xassert (HASH_TABLE_P (table));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3677 xassert (XHASH_TABLE (table) == h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3678
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3679 /* 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
3680 if (NILP (h->weak))
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
3681 h->next_weak = NULL;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3682 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3683 {
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
3684 h->next_weak = weak_hash_tables;
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
3685 weak_hash_tables = h;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3686 }
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 return table;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3689 }
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
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3692 /* 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
3693 only the table itself is. */
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3694
112023
ac49e05bfcf2 Remove unused declarations
Andreas Schwab <schwab@linux-m68k.org>
parents: 110543
diff changeset
3695 static Lisp_Object
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3696 copy_hash_table (struct Lisp_Hash_Table *h1)
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3697 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3698 Lisp_Object table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3699 struct Lisp_Hash_Table *h2;
40769
fa1546836808 (copy_hash_table): Remove unused variable `v'.
Pavel Janík <Pavel@Janik.cz>
parents: 40734
diff changeset
3700 struct Lisp_Vector *next;
36431
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
3701
c10e67afd7ec (Fdelete, larger_vector): Use allocate_vector.
Gerd Moellmann <gerd@gnu.org>
parents: 36256
diff changeset
3702 h2 = allocate_hash_table ();
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3703 next = h2->vec_next;
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
3704 memcpy (h2, h1, sizeof *h2);
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3705 h2->vec_next = next;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3706 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
3707 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
3708 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
3709 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
3710 XSET_HASH_TABLE (table, h2);
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3711
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3712 /* 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
3713 if (!NILP (h2->weak))
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3714 {
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
3715 h2->next_weak = weak_hash_tables;
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
3716 weak_hash_tables = h2;
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3717 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3718
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3719 return table;
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3720 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3721
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
3722
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3723 /* 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
3724 because it's already too large, throw an error. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3725
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3726 static INLINE void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3727 maybe_resize_hash_table (struct Lisp_Hash_Table *h)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3728 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3729 if (NILP (h->next_free))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3730 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3731 int old_size = HASH_TABLE_SIZE (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3732 int i, new_size, index_size;
75218
6a5ce97ea40d (maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents: 74169
diff changeset
3733 EMACS_INT nsize;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3734
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3735 if (INTEGERP (h->rehash_size))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3736 new_size = old_size + XFASTINT (h->rehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3737 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3738 new_size = old_size * XFLOATINT (h->rehash_size);
27901
70c1647c2bfc (maybe_resize_hash_table): Handle case of new size
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3739 new_size = max (old_size + 1, new_size);
29809
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
3740 index_size = next_almost_prime ((int)
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
3741 (new_size
88aa46c9dfde (make_hash_table, maybe_resize_hash_table): Cast arg of
Dave Love <fx@gnu.org>
parents: 29232
diff changeset
3742 / XFLOATINT (h->rehash_threshold)));
75218
6a5ce97ea40d (maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents: 74169
diff changeset
3743 /* Assignment to EMACS_INT stops GCC whining about limited range
6a5ce97ea40d (maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents: 74169
diff changeset
3744 of data type. */
6a5ce97ea40d (maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents: 74169
diff changeset
3745 nsize = max (index_size, 2 * new_size);
6a5ce97ea40d (maybe_resize_hash_table): Copy new size of hash table into EMACS_INT to avoid
Eli Zaretskii <eliz@gnu.org>
parents: 74169
diff changeset
3746 if (nsize > MOST_POSITIVE_FIXNUM)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3747 error ("Hash table too large to resize");
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3748
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3749 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
3750 h->next = larger_vector (h->next, new_size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3751 h->hash = larger_vector (h->hash, new_size, Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3752 h->index = Fmake_vector (make_number (index_size), Qnil);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3753
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3754 /* 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
3755 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
3756 maphash faster. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3757 for (i = old_size; i < new_size - 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);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3759
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3760 if (!NILP (h->next_free))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3761 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3762 Lisp_Object last, next;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3763
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3764 last = h->next_free;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3765 while (next = HASH_NEXT (h, XFASTINT (last)),
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3766 !NILP (next))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3767 last = next;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3768
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3769 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3770 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3771 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3772 XSETFASTINT (h->next_free, old_size);
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 /* Rehash. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3775 for (i = 0; i < old_size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3776 if (!NILP (HASH_HASH (h, i)))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3777 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3778 unsigned hash_code = XUINT (HASH_HASH (h, i));
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
3779 int start_of_bucket = hash_code % ASIZE (h->index);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3780 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3781 HASH_INDEX (h, start_of_bucket) = make_number (i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3782 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3783 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3784 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3785
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3786
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3787 /* 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
3788 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
3789 matching KEY, or -1 if not found. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3790
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3791 int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3792 hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, unsigned int *hash)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3793 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3794 unsigned hash_code;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3795 int start_of_bucket;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3796 Lisp_Object idx;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3797
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3798 hash_code = h->hashfn (h, key);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3799 if (hash)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3800 *hash = hash_code;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3801
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
3802 start_of_bucket = hash_code % ASIZE (h->index);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3803 idx = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3804
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3805 /* We need not gcpro idx since it's either an integer or nil. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3806 while (!NILP (idx))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3807 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3808 int i = XFASTINT (idx);
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3809 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
3810 || (h->cmpfn
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3811 && h->cmpfn (h, key, hash_code,
28507
b6f06a755c7d make_number/XINT/XUINT conversions; EQ/== fixes; ==Qnil -> NILP
Ken Raeburn <raeburn@raeburn.org>
parents: 28493
diff changeset
3812 HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3813 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3814 idx = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3815 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3816
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3817 return NILP (idx) ? -1 : XFASTINT (idx);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3818 }
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3821 /* 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
3822 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
3823 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
3824
c629af522c09 (Flength): The length of char-table is MAX_CHAR.
Kenichi Handa <handa@m17n.org>
parents: 26596
diff changeset
3825 int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3826 hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, unsigned int hash)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3827 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3828 int start_of_bucket, i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3829
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
3830 xassert ((hash & ~INTMASK) == 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3831
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3832 /* Increment count after resizing because resizing may fail. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3833 maybe_resize_hash_table (h);
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
3834 h->count++;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3835
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3836 /* Store key/value in the key_and_value vector. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3837 i = XFASTINT (h->next_free);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3838 h->next_free = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3839 HASH_KEY (h, i) = key;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3840 HASH_VALUE (h, i) = value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3841
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3842 /* Remember its hash code. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3843 HASH_HASH (h, i) = make_number (hash);
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 /* Add new entry to its collision chain. */
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
3846 start_of_bucket = hash % ASIZE (h->index);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3847 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3848 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
3849 return i;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3850 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3851
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3852
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3853 /* 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
3854
96764
1307c33f5e9a * ecrt0.c: Remove code depending on m68000, not used anymore.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96502
diff changeset
3855 static void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3856 hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3857 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3858 unsigned hash_code;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3859 int start_of_bucket;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3860 Lisp_Object idx, prev;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3861
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3862 hash_code = h->hashfn (h, key);
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
3863 start_of_bucket = hash_code % ASIZE (h->index);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3864 idx = HASH_INDEX (h, start_of_bucket);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3865 prev = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3866
28555
976bc44944da (mapcar1): Test for null vals to support mapc.
Dave Love <fx@gnu.org>
parents: 28507
diff changeset
3867 /* We need not gcpro idx, prev since they're either integers or nil. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3868 while (!NILP (idx))
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 int i = XFASTINT (idx);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3871
25349
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3872 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
3873 || (h->cmpfn
ee30c32ea191 (hash_lookup): Test with EQ before calling key comparion
Gerd Moellmann <gerd@gnu.org>
parents: 25149
diff changeset
3874 && h->cmpfn (h, key, hash_code,
28507
b6f06a755c7d make_number/XINT/XUINT conversions; EQ/== fixes; ==Qnil -> NILP
Ken Raeburn <raeburn@raeburn.org>
parents: 28493
diff changeset
3875 HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3876 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3877 /* Take entry out of collision chain. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3878 if (NILP (prev))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3879 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3880 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3881 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3882
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3883 /* 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
3884 the free list. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3885 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
3886 HASH_NEXT (h, i) = h->next_free;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3887 h->next_free = make_number (i);
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
3888 h->count--;
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
3889 xassert (h->count >= 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3890 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3891 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3892 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3893 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3894 prev = idx;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3895 idx = HASH_NEXT (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3896 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3897 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3898 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3899
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3900
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3901 /* Clear hash table H. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3902
112023
ac49e05bfcf2 Remove unused declarations
Andreas Schwab <schwab@linux-m68k.org>
parents: 110543
diff changeset
3903 static void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3904 hash_clear (struct Lisp_Hash_Table *h)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3905 {
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
3906 if (h->count > 0)
25005
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 int i, size = HASH_TABLE_SIZE (h);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3909
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3910 for (i = 0; i < size; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3911 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3912 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
3913 HASH_KEY (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3914 HASH_VALUE (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3915 HASH_HASH (h, i) = Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3916 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3917
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
3918 for (i = 0; i < ASIZE (h->index); ++i)
91667
b3e6289494fb (concat): Move side effect outside of macro call.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 91367
diff changeset
3919 ASET (h->index, i, Qnil);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3920
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3921 h->next_free = make_number (0);
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
3922 h->count = 0;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3923 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3924 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3925
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3926
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3927
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3928 /************************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3929 Weak Hash Tables
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3930 ************************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
3931
94992
05fbecb52ee0 (init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents: 94963
diff changeset
3932 void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3933 init_weak_hash_tables (void)
94992
05fbecb52ee0 (init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents: 94963
diff changeset
3934 {
05fbecb52ee0 (init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents: 94963
diff changeset
3935 weak_hash_tables = NULL;
05fbecb52ee0 (init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents: 94963
diff changeset
3936 }
05fbecb52ee0 (init_fns): Don't initialize weak_hash_tables here.
Chong Yidong <cyd@stupidchicken.com>
parents: 94963
diff changeset
3937
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3938 /* 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
3939 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
3940 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
3941 non-zero if anything was marked. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3942
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3943 static int
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
3944 sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3945 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3946 int bucket, n, marked;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3947
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
3948 n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3949 marked = 0;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3950
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3951 for (bucket = 0; bucket < n; ++bucket)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3952 {
35513
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
3953 Lisp_Object idx, next, prev;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3954
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3955 /* Follow collision chain, removing entries that
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3956 don't survive this garbage collection. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3957 prev = Qnil;
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
3958 for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3959 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3960 int i = XFASTINT (idx);
35513
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
3961 int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
3962 int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
3963 int remove_p;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3964
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3965 if (EQ (h->weak, Qkey))
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
3966 remove_p = !key_known_to_survive_p;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3967 else if (EQ (h->weak, Qvalue))
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
3968 remove_p = !value_known_to_survive_p;
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
3969 else if (EQ (h->weak, Qkey_or_value))
30637
b54946f3cbbc (sweep_weak_table): Fix survival conditions for
Gerd Moellmann <gerd@gnu.org>
parents: 30634
diff changeset
3970 remove_p = !(key_known_to_survive_p || value_known_to_survive_p);
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
3971 else if (EQ (h->weak, Qkey_and_value))
30637
b54946f3cbbc (sweep_weak_table): Fix survival conditions for
Gerd Moellmann <gerd@gnu.org>
parents: 30634
diff changeset
3972 remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3973 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3974 abort ();
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3975
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3976 next = HASH_NEXT (h, i);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3977
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3978 if (remove_entries_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3979 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3980 if (remove_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3981 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3982 /* Take out of collision chain. */
90970
3371fc48749b Replace uses of GC_* macros with the non-GC_ versions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 90918
diff changeset
3983 if (NILP (prev))
35513
0fbf1517a670 (sweep_weak_table): Fix code taking items out of
Gerd Moellmann <gerd@gnu.org>
parents: 35479
diff changeset
3984 HASH_INDEX (h, bucket) = next;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3985 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3986 HASH_NEXT (h, XFASTINT (prev)) = next;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3987
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3988 /* Add to free list. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3989 HASH_NEXT (h, i) = h->next_free;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3990 h->next_free = idx;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3991
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3992 /* Clear key, value, and hash. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3993 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3994 HASH_HASH (h, i) = Qnil;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
3995
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
3996 h->count--;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
3997 }
59630
e35417abe6a6 (sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents: 59490
diff changeset
3998 else
e35417abe6a6 (sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents: 59490
diff changeset
3999 {
e35417abe6a6 (sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents: 59490
diff changeset
4000 prev = idx;
e35417abe6a6 (sweep_weak_table): Advance prev pointer when we keep a pair.
Kim F. Storm <storm@cua.dk>
parents: 59490
diff changeset
4001 }
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4002 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4003 else
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4004 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4005 if (!remove_p)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4006 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4007 /* Make sure key and value survive. */
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4008 if (!key_known_to_survive_p)
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4009 {
51768
31f2f6a2df06 (sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51397
diff changeset
4010 mark_object (HASH_KEY (h, i));
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4011 marked = 1;
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4012 }
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4013
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4014 if (!value_known_to_survive_p)
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4015 {
51768
31f2f6a2df06 (sweep_weak_table): Update calls to mark_object.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51397
diff changeset
4016 mark_object (HASH_VALUE (h, i));
30007
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4017 marked = 1;
d9c85e2f07ba (sweep_weak_table): Mark only objects that are not
Gerd Moellmann <gerd@gnu.org>
parents: 29991
diff changeset
4018 }
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4019 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4020 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4021 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4022 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4023
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4024 return marked;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4025 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4026
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4027 /* 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
4028 current garbage collection. Remove weak tables that don't survive
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4029 from Vweak_hash_tables. Called from gc_sweep. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4030
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4031 void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4032 sweep_weak_hash_tables (void)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4033 {
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
4034 struct Lisp_Hash_Table *h, *used, *next;
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4035 int marked;
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4036
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4037 /* 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
4038 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
4039 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
4040 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
4041 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
4042 one finds that it shouldn't. */
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4043 do
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4044 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4045 marked = 0;
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
4046 for (h = weak_hash_tables; h; h = h->next_weak)
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4047 {
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4048 if (h->size & ARRAY_MARK_FLAG)
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4049 marked |= sweep_weak_table (h, 0);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4050 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4051 }
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4052 while (marked);
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4053
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4054 /* Remove tables and entries that aren't used. */
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
4055 for (h = weak_hash_tables, used = NULL; h; h = next)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4056 {
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4057 next = h->next_weak;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4058
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4059 if (h->size & ARRAY_MARK_FLAG)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4060 {
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4061 /* TABLE is marked as used. Sweep its contents. */
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
4062 if (h->count > 0)
27530
774df97ad330 (sweep_weak_table): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 26856
diff changeset
4063 sweep_weak_table (h, 1);
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4064
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4065 /* Add table to the list of used weak hash tables. */
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4066 h->next_weak = used;
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
4067 used = h;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4068 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4069 }
30634
d833a6450e10 (sweep_weak_hash_tables): Fix the code taking unmarked
Gerd Moellmann <gerd@gnu.org>
parents: 30602
diff changeset
4070
81813
32d8fd242bb2 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81794
diff changeset
4071 weak_hash_tables = used;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4072 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4073
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4074
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4075
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4076 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4077 Hash Code Computation
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4078 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4079
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4080 /* Maximum depth up to which to dive into Lisp structures. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4081
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4082 #define SXHASH_MAX_DEPTH 3
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4083
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4084 /* 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
4085 account. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4086
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4087 #define SXHASH_MAX_LEN 7
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4088
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4089 /* Combine two integers X and Y for hashing. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4090
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4091 #define SXHASH_COMBINE(X, Y) \
25709
ba4e2a641663 (SXHASH_COMBINE): Add missing parentheses.
Gerd Moellmann <gerd@gnu.org>
parents: 25690
diff changeset
4092 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4093 + (unsigned)(Y))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4094
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4095
30760
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4096 /* Return a hash for string PTR which has length LEN. The hash
c5077abd4ef2 (hashfn_eq, hashfn_eql): Don't handle strings specially
Gerd Moellmann <gerd@gnu.org>
parents: 30637
diff changeset
4097 code returned is guaranteed to fit in a Lisp integer. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4098
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4099 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4100 sxhash_string (unsigned char *ptr, int len)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4101 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4102 unsigned char *p = ptr;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4103 unsigned char *end = p + len;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4104 unsigned char c;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4105 unsigned hash = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4106
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4107 while (p != end)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4108 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4109 c = *p++;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4110 if (c >= 0140)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4111 c -= 40;
72511
1ef51160f403 (sxhash_string): Rotate properly; don't lose bits.
Richard M. Stallman <rms@gnu.org>
parents: 72136
diff changeset
4112 hash = ((hash << 4) + (hash >> 28) + c);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4113 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4114
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4115 return hash & INTMASK;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4116 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4117
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4118
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4119 /* 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
4120 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
4121
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4122 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4123 sxhash_list (Lisp_Object list, int depth)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4124 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4125 unsigned hash = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4126 int i;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4127
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4128 if (depth < SXHASH_MAX_DEPTH)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4129 for (i = 0;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4130 CONSP (list) && i < SXHASH_MAX_LEN;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4131 list = XCDR (list), ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4132 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4133 unsigned hash2 = sxhash (XCAR (list), depth + 1);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4134 hash = SXHASH_COMBINE (hash, hash2);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4135 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4136
69655
b1e3b0da5945 (sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
4137 if (!NILP (list))
b1e3b0da5945 (sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
4138 {
b1e3b0da5945 (sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
4139 unsigned hash2 = sxhash (list, depth + 1);
b1e3b0da5945 (sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
4140 hash = SXHASH_COMBINE (hash, hash2);
b1e3b0da5945 (sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
4141 }
b1e3b0da5945 (sxhash_list): Include last non-nil CDR in hash.
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
4142
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4143 return hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4144 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4145
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 /* 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
4148 the Lisp structure. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4149
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4150 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4151 sxhash_vector (Lisp_Object vec, int depth)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4152 {
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
4153 unsigned hash = ASIZE (vec);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4154 int i, n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4155
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
4156 n = min (SXHASH_MAX_LEN, ASIZE (vec));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4157 for (i = 0; i < n; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4158 {
74163
f7736a8bd079 Use AREF/ASIZE macros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 74101
diff changeset
4159 unsigned hash2 = sxhash (AREF (vec, i), depth + 1);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4160 hash = SXHASH_COMBINE (hash, hash2);
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 return hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4164 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4165
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4166
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4167 /* Return a hash for bool-vector VECTOR. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4168
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4169 static unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4170 sxhash_bool_vector (Lisp_Object vec)
25005
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 unsigned hash = XBOOL_VECTOR (vec)->size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4173 int i, n;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4174
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4175 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4176 for (i = 0; i < n; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4177 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
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 hash;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4182
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4183 /* Return a hash code for OBJ. DEPTH is the current depth in the Lisp
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4184 structure. Value is an unsigned integer clipped to INTMASK. */
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4185
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4186 unsigned
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4187 sxhash (Lisp_Object obj, int depth)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4188 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4189 unsigned hash;
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 if (depth > SXHASH_MAX_DEPTH)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4192 return 0;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4193
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4194 switch (XTYPE (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4195 {
105885
8103235103a7 Let integers use up 2 tags to give them one extra bit and double their range.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105877
diff changeset
4196 case_Lisp_Int:
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4197 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4198 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4199
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4200 case Lisp_Misc:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4201 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4202 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4203
57988
75429b9aa2f2 (sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents: 57726
diff changeset
4204 case Lisp_Symbol:
75429b9aa2f2 (sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents: 57726
diff changeset
4205 obj = SYMBOL_NAME (obj);
75429b9aa2f2 (sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents: 57726
diff changeset
4206 /* Fall through. */
75429b9aa2f2 (sxhash): As far as possible, merge calculation of
Eli Zaretskii <eliz@gnu.org>
parents: 57726
diff changeset
4207
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4208 case Lisp_String:
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
4209 hash = sxhash_string (SDATA (obj), SCHARS (obj));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4210 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4211
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4212 /* This can be everything from a vector to an overlay. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4213 case Lisp_Vectorlike:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4214 if (VECTORP (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4215 /* 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
4216 they are `eq', except for strings and bit-vectors. In
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4217 Emacs, this works differently. We have to compare element
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4218 by element. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4219 hash = sxhash_vector (obj, depth);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4220 else if (BOOL_VECTOR_P (obj))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4221 hash = sxhash_bool_vector (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4222 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4223 /* 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
4224 address as hash. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4225 hash = XUINT (obj);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4226 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4227
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4228 case Lisp_Cons:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4229 hash = sxhash_list (obj, depth);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4230 break;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4231
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4232 case Lisp_Float:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4233 {
104313
73f76307d49b * lisp.h (XFLOAT_DATA): Produce an rvalue by adding 0 to the value.
Ken Raeburn <raeburn@raeburn.org>
parents: 104225
diff changeset
4234 double val = XFLOAT_DATA (obj);
73f76307d49b * lisp.h (XFLOAT_DATA): Produce an rvalue by adding 0 to the value.
Ken Raeburn <raeburn@raeburn.org>
parents: 104225
diff changeset
4235 unsigned char *p = (unsigned char *) &val;
73f76307d49b * lisp.h (XFLOAT_DATA): Produce an rvalue by adding 0 to the value.
Ken Raeburn <raeburn@raeburn.org>
parents: 104225
diff changeset
4236 unsigned char *e = p + sizeof val;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4237 for (hash = 0; p < e; ++p)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4238 hash = SXHASH_COMBINE (hash, *p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4239 break;
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4242 default:
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4243 abort ();
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
53090
86e42266b65e (hashfn_eq, hashfn_eql, hashfn_equal, hash_put)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53042
diff changeset
4246 return hash & INTMASK;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4247 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4248
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4249
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4250
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4251 /***********************************************************************
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4252 Lisp Interface
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4253 ***********************************************************************/
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4254
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4255
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4256 DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4257 doc: /* Compute a hash code for OBJ and return it as integer. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4258 (Lisp_Object obj)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4259 {
77908
e5fb6472b6db (Fsxhash): Delete stray semicolon.
Chong Yidong <cyd@stupidchicken.com>
parents: 75348
diff changeset
4260 unsigned hash = sxhash (obj, 0);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4261 return make_number (hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4262 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4263
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4264
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4265 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4266 doc: /* Create and return a new hash table.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4267
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4268 Arguments are specified as keyword/argument pairs. The following
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4269 arguments are defined:
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4270
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4271 :test TEST -- TEST must be a symbol that specifies how to compare
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4272 keys. Default is `eql'. Predefined are the tests `eq', `eql', and
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4273 `equal'. User-supplied test and hash functions can be specified via
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4274 `define-hash-table-test'.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4275
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4276 :size SIZE -- A hint as to how many elements will be put in the table.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4277 Default is 65.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4278
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4279 :rehash-size REHASH-SIZE - Indicates how to expand the table when it
109773
0b99cd248806 * fns.c (Fmake_hash_table): Doc fix (Bug#6851).
Chong Yidong <cyd@stupidchicken.com>
parents: 109716
diff changeset
4280 fills up. If REHASH-SIZE is an integer, increase the size by that
0b99cd248806 * fns.c (Fmake_hash_table): Doc fix (Bug#6851).
Chong Yidong <cyd@stupidchicken.com>
parents: 109716
diff changeset
4281 amount. If it is a float, it must be > 1.0, and the new size is the
0b99cd248806 * fns.c (Fmake_hash_table): Doc fix (Bug#6851).
Chong Yidong <cyd@stupidchicken.com>
parents: 109716
diff changeset
4282 old size multiplied by that factor. Default is 1.5.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4283
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4284 :rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
4285 Resize the hash table when the ratio (number of entries / table size)
109782
fe1680d2025e Minor doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 109773
diff changeset
4286 is greater than or equal to THRESHOLD. Default is 0.8.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4287
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4288 :weakness WEAK -- WEAK must be one of nil, t, `key', `value',
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4289 `key-or-value', or `key-and-value'. If WEAK is not nil, the table
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4290 returned is a weak table. Key/value pairs are removed from a weak
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4291 hash table when there are no non-weak references pointing to their
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4292 key, value, one of key or value, or both key and value, depending on
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4293 WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
40132
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
4294 is nil.
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
4295
75fe73bea452 (Fappend, Fconcat, Fvconcat, Fnconc, Fwidget_apply, Fmake_hash_table):
Miles Bader <miles@gnu.org>
parents: 39977
diff changeset
4296 usage: (make-hash-table &rest KEYWORD-ARGS) */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4297 (int nargs, Lisp_Object *args)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4298 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4299 Lisp_Object test, size, rehash_size, rehash_threshold, weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4300 Lisp_Object user_test, user_hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4301 char *used;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4302 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4303
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4304 /* 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
4305 have been consumed. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4306 used = (char *) alloca (nargs * sizeof *used);
109165
750db9f3e6d8 Replace bcopy, bzero, bcmp by memcpy, memmove, memset, memcmp
Andreas Schwab <schwab@linux-m68k.org>
parents: 109126
diff changeset
4307 memset (used, 0, nargs * sizeof *used);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4308
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4309 /* See if there's a `:test TEST' among the arguments. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4310 i = get_key_arg (QCtest, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4311 test = i < 0 ? Qeql : args[i];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4312 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
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 /* See if it is a user-defined test. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4315 Lisp_Object prop;
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4316
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4317 prop = Fget (test, Qhash_table_test);
40734
95dd892ad5e3 (Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents: 40656
diff changeset
4318 if (!CONSP (prop) || !CONSP (XCDR (prop)))
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4319 signal_error ("Invalid hash table test", test);
40734
95dd892ad5e3 (Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents: 40656
diff changeset
4320 user_test = XCAR (prop);
95dd892ad5e3 (Fmake_hash_table): Use XCAR and XCDR, not Fnth and Flength.
Richard M. Stallman <rms@gnu.org>
parents: 40656
diff changeset
4321 user_hash = XCAR (XCDR (prop));
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4322 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4323 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4324 user_test = user_hash = Qnil;
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 /* See if there's a `:size SIZE' argument. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4327 i = get_key_arg (QCsize, nargs, args, used);
46221
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
4328 size = i < 0 ? Qnil : args[i];
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
4329 if (NILP (size))
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
4330 size = make_number (DEFAULT_HASH_SIZE);
2f81e2382d8d (Fnconc): Use XCDR.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45650
diff changeset
4331 else if (!INTEGERP (size) || XINT (size) < 0)
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4332 signal_error ("Invalid hash table size", size);
25005
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 /* Look for `:rehash-size SIZE'. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4335 i = get_key_arg (QCrehash_size, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4336 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
4337 if (!NUMBERP (rehash_size)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4338 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4339 || XFLOATINT (rehash_size) <= 1.0)
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4340 signal_error ("Invalid hash table rehash size", rehash_size);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4341
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4342 /* Look for `:rehash-threshold THRESHOLD'. */
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4343 i = get_key_arg (QCrehash_threshold, nargs, args, used);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4344 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
4345 if (!FLOATP (rehash_threshold)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4346 || XFLOATINT (rehash_threshold) <= 0.0
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4347 || XFLOATINT (rehash_threshold) > 1.0)
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4348 signal_error ("Invalid hash table rehash threshold", rehash_threshold);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4349
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4350 /* Look for `:weakness WEAK'. */
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4351 i = get_key_arg (QCweakness, nargs, args, used);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4352 weak = i < 0 ? Qnil : args[i];
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4353 if (EQ (weak, Qt))
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4354 weak = Qkey_and_value;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4355 if (!NILP (weak)
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4356 && !EQ (weak, Qkey)
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4357 && !EQ (weak, Qvalue)
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4358 && !EQ (weak, Qkey_or_value)
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4359 && !EQ (weak, Qkey_and_value))
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4360 signal_error ("Invalid hash table weakness", weak);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4361
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4362 /* 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
4363 for (i = 0; i < nargs; ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4364 if (!used[i])
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4365 signal_error ("Invalid argument list", args[i]);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4366
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4367 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
4368 user_test, user_hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4369 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4370
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4371
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4372 DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4373 doc: /* Return a copy of hash table TABLE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4374 (Lisp_Object table)
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4375 {
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4376 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
4377 }
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4378
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4379
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4380 DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4381 doc: /* Return the number of elements in TABLE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4382 (Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4383 {
85021
a0c901e4e649 * lisp.h (struct Lisp_Hash_Table): Move non-traced elements at the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 83648
diff changeset
4384 return make_number (check_hash_table (table)->count);
25005
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
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4387
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4388 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4389 Shash_table_rehash_size, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4390 doc: /* Return the current rehash size of TABLE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4391 (Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4392 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4393 return check_hash_table (table)->rehash_size;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4394 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4395
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4396
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4397 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4398 Shash_table_rehash_threshold, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4399 doc: /* Return the current rehash threshold of TABLE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4400 (Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4401 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4402 return check_hash_table (table)->rehash_threshold;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4403 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4404
25005
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 DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4407 doc: /* Return the size of TABLE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4408 The size can be used as an argument to `make-hash-table' to create
109696
637b204b4c71 fns.c: Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 108933
diff changeset
4409 a hash table than can hold as many elements as TABLE holds
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4410 without need for resizing. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4411 (Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4412 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4413 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4414 return make_number (HASH_TABLE_SIZE (h));
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4415 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4416
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4417
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4418 DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4419 doc: /* Return the test TABLE uses. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4420 (Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4421 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4422 return check_hash_table (table)->test;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4423 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4424
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4425
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
4426 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
4427 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4428 doc: /* Return the weakness of TABLE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4429 (Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4430 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4431 return check_hash_table (table)->weak;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4432 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4433
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4434
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4435 DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4436 doc: /* Return t if OBJ is a Lisp hash table object. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4437 (Lisp_Object obj)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4438 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4439 return HASH_TABLE_P (obj) ? Qt : Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4440 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4441
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4442
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4443 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
87961
868797e785eb (Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 87903
diff changeset
4444 doc: /* Clear hash table TABLE and return it. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4445 (Lisp_Object table)
25005
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 hash_clear (check_hash_table (table));
87961
868797e785eb (Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 87903
diff changeset
4448 /* Be compatible with XEmacs. */
868797e785eb (Fclrhash): Return TABLE.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 87903
diff changeset
4449 return table;
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4450 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4451
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 DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4454 doc: /* Look up KEY in TABLE and return its associated value.
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4455 If KEY is not found, return DFLT which defaults to nil. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4456 (Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4457 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4458 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4459 int i = hash_lookup (h, key, NULL);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4460 return i >= 0 ? HASH_VALUE (h, i) : dflt;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4461 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4462
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4463
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4464 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4465 doc: /* Associate KEY with VALUE in hash table TABLE.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4466 If KEY is already present in table, replace its current value with
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4467 VALUE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4468 (Lisp_Object key, Lisp_Object value, Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4469 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4470 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4471 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4472 unsigned hash;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4473
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4474 i = hash_lookup (h, key, &hash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4475 if (i >= 0)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4476 HASH_VALUE (h, i) = value;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4477 else
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4478 hash_put (h, key, value, hash);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4479
29991
fff5fd809d11 (Fputhash): Return `value' rather than nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29979
diff changeset
4480 return value;
25005
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
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4483
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4484 DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4485 doc: /* Remove KEY from TABLE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4486 (Lisp_Object key, Lisp_Object table)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4487 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4488 struct Lisp_Hash_Table *h = check_hash_table (table);
96815
be932007d518 by renaming, get rid of need for hash_remove() redefinitions for NS platform; also, adjust nsgui dependencies in Makefile
Adrian Robert <Adrian.B.Robert@gmail.com>
parents: 96764
diff changeset
4489 hash_remove_from_table (h, key);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4490 return Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4491 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4492
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4493
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4494 DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4495 doc: /* Call FUNCTION for all entries in hash table TABLE.
63173
66bf26afd9c6 (Fmemq, Fmaphash): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 62950
diff changeset
4496 FUNCTION is called with two arguments, KEY and VALUE. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4497 (Lisp_Object function, Lisp_Object table)
25005
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 struct Lisp_Hash_Table *h = check_hash_table (table);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4500 Lisp_Object args[3];
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4501 int i;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4502
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4503 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4504 if (!NILP (HASH_HASH (h, i)))
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4505 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4506 args[0] = function;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4507 args[1] = HASH_KEY (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4508 args[2] = HASH_VALUE (h, i);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4509 Ffuncall (3, args);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4510 }
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4511
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4512 return Qnil;
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4513 }
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4514
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4515
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4516 DEFUN ("define-hash-table-test", Fdefine_hash_table_test,
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4517 Sdefine_hash_table_test, 3, 3, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4518 doc: /* Define a new hash table test with name NAME, a symbol.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4519
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4520 In hash tables created with NAME specified as test, use TEST to
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4521 compare keys, and HASH for computing hash codes of keys.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4522
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4523 TEST must be a function taking two arguments and returning non-nil if
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4524 both arguments are the same. HASH must be a function taking one
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4525 argument and return an integer that is the hash code of the argument.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4526 Hash code computation should use the whole value range of integers,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4527 including negative integers. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4528 (Lisp_Object name, Lisp_Object test, Lisp_Object hash)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4529 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4530 return Fput (name, Qhash_table_test, list2 (test, hash));
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
28965
dead0196fbc8 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 28962
diff changeset
4533
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4534
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4535 /************************************************************************
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4536 MD5
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4537 ************************************************************************/
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4538
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4539 #include "md5.h"
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4540
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4541 DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4542 doc: /* Return MD5 message digest of OBJECT, a buffer or string.
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4543
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4544 A message digest is a cryptographic checksum of a document, and the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4545 algorithm to calculate it is defined in RFC 1321.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4546
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4547 The two optional arguments START and END are character positions
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4548 specifying for which part of OBJECT the message digest should be
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4549 computed. If nil or omitted, the digest is computed for the whole
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4550 OBJECT.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4551
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4552 The MD5 message digest is computed from the result of encoding the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4553 text in a coding system, not directly from the internal Emacs form of
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4554 the text. The optional fourth argument CODING-SYSTEM specifies which
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4555 coding system to encode the text with. It should be the same coding
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4556 system that you used or will use when actually writing the text into a
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4557 file.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4558
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4559 If CODING-SYSTEM is nil or omitted, the default depends on OBJECT. If
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4560 OBJECT is a buffer, the default for CODING-SYSTEM is whatever coding
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4561 system would be chosen by default for writing this text into a file.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4562
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4563 If OBJECT is a string, the most preferred coding system (see the
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4564 command `prefer-coding-system') is used.
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4565
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4566 If NOERROR is non-nil, silently assume the `raw-text' coding if the
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4567 guesswork fails. Normally, an error is signaled in such case. */)
109179
8cfee7d2955f Convert DEFUNs to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109165
diff changeset
4568 (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror)
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4569 {
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4570 unsigned char digest[16];
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4571 unsigned char value[33];
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4572 int i;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
4573 EMACS_INT size;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
4574 EMACS_INT size_byte = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
4575 EMACS_INT start_char = 0, end_char = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
4576 EMACS_INT start_byte = 0, end_byte = 0;
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
4577 register EMACS_INT b, e;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4578 register struct buffer *bp;
110543
a89eabac600d Fix int/EMACS_INT usage in fns.c.
Eli Zaretskii <eliz@gnu.org>
parents: 110503
diff changeset
4579 EMACS_INT temp;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4580
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4581 if (STRINGP (object))
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4582 {
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4583 if (NILP (coding_system))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4584 {
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4585 /* Decide the coding-system to encode the data with. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4586
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4587 if (STRING_MULTIBYTE (object))
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4588 /* use default, we can't guess correct value */
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
4589 coding_system = preferred_coding_system ();
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4590 else
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4591 coding_system = Qraw_text;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4592 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4593
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4594 if (NILP (Fcoding_system_p (coding_system)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4595 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4596 /* Invalid coding system. */
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4597
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4598 if (!NILP (noerror))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4599 coding_system = Qraw_text;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4600 else
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4601 xsignal1 (Qcoding_system_error, coding_system);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4602 }
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4603
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4604 if (STRING_MULTIBYTE (object))
88375
38cab5bfa62b Include "character.h" instead of "charset.h".
Kenichi Handa <handa@m17n.org>
parents: 41006
diff changeset
4605 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4606
46370
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
4607 size = SCHARS (object);
40db0673e6f0 Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents: 46293
diff changeset
4608 size_byte = SBYTES (object);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4609
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4610 if (!NILP (start))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4611 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
4612 CHECK_NUMBER (start);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4613
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4614 start_char = XINT (start);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4615
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4616 if (start_char < 0)
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4617 start_char += size;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4618
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4619 start_byte = string_char_to_byte (object, start_char);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4620 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4621
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4622 if (NILP (end))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4623 {
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4624 end_char = size;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4625 end_byte = size_byte;
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4626 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4627 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4628 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
4629 CHECK_NUMBER (end);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4630
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4631 end_char = XINT (end);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4632
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4633 if (end_char < 0)
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4634 end_char += size;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4635
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4636 end_byte = string_char_to_byte (object, end_char);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4637 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4638
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4639 if (!(0 <= start_char && start_char <= end_char && end_char <= size))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4640 args_out_of_range_3 (object, make_number (start_char),
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4641 make_number (end_char));
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4642 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4643 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4644 {
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4645 struct buffer *prev = current_buffer;
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4646
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4647 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4648
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
4649 CHECK_BUFFER (object);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4650
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4651 bp = XBUFFER (object);
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4652 if (bp != current_buffer)
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4653 set_buffer_internal (bp);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4654
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4655 if (NILP (start))
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4656 b = BEGV;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4657 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4658 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
4659 CHECK_NUMBER_COERCE_MARKER (start);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4660 b = XINT (start);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4661 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4662
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4663 if (NILP (end))
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4664 e = ZV;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4665 else
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4666 {
40656
cdfd4d09b79a Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents: 40550
diff changeset
4667 CHECK_NUMBER_COERCE_MARKER (end);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4668 e = XINT (end);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4669 }
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4670
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4671 if (b > e)
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4672 temp = b, b = e, e = temp;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4673
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4674 if (!(BEGV <= b && e <= ZV))
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4675 args_out_of_range (start, end);
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4676
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4677 if (NILP (coding_system))
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4678 {
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4679 /* Decide the coding-system to encode the data with.
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4680 See fileio.c:Fwrite-region */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4681
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4682 if (!NILP (Vcoding_system_for_write))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4683 coding_system = Vcoding_system_for_write;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4684 else
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4685 {
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4686 int force_raw_text = 0;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4687
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4688 coding_system = XBUFFER (object)->buffer_file_coding_system;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4689 if (NILP (coding_system)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4690 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4691 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4692 coding_system = Qnil;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4693 if (NILP (current_buffer->enable_multibyte_characters))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4694 force_raw_text = 1;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4695 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4696
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4697 if (NILP (coding_system) && !NILP (Fbuffer_file_name(object)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4698 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4699 /* Check file-coding-system-alist. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4700 Lisp_Object args[4], val;
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4701
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4702 args[0] = Qwrite_region; args[1] = start; args[2] = end;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4703 args[3] = Fbuffer_file_name(object);
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4704 val = Ffind_operation_coding_system (4, args);
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4705 if (CONSP (val) && !NILP (XCDR (val)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4706 coding_system = XCDR (val);
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4707 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4708
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4709 if (NILP (coding_system)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4710 && !NILP (XBUFFER (object)->buffer_file_coding_system))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4711 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4712 /* If we still have not decided a coding system, use the
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4713 default value of buffer-file-coding-system. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4714 coding_system = XBUFFER (object)->buffer_file_coding_system;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4715 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4716
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4717 if (!force_raw_text
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4718 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4719 /* Confirm that VAL can surely encode the current region. */
45629
6adda7388fcc (md5): Pass FILE arg to Vselect_safe_coding_system_function.
Richard M. Stallman <rms@gnu.org>
parents: 45401
diff changeset
4720 coding_system = call4 (Vselect_safe_coding_system_function,
34153
f493b32a1a91 (Fmd5): Pass lisp objects, not integers, to call3.
Ken Raeburn <raeburn@raeburn.org>
parents: 34106
diff changeset
4721 make_number (b), make_number (e),
45629
6adda7388fcc (md5): Pass FILE arg to Vselect_safe_coding_system_function.
Richard M. Stallman <rms@gnu.org>
parents: 45401
diff changeset
4722 coding_system, Qnil);
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4723
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4724 if (force_raw_text)
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4725 coding_system = Qraw_text;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4726 }
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4727
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4728 if (NILP (Fcoding_system_p (coding_system)))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4729 {
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4730 /* Invalid coding system. */
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4731
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4732 if (!NILP (noerror))
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4733 coding_system = Qraw_text;
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4734 else
71979
dd7e7d68e3b0 (Flength): wrong_type_argument is no-return.
Kim F. Storm <storm@cua.dk>
parents: 71833
diff changeset
4735 xsignal1 (Qcoding_system_error, coding_system);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4736 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4737 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4738
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4739 object = make_buffer_string (b, e, 0);
53681
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4740 if (prev != current_buffer)
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4741 set_buffer_internal (prev);
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4742 /* Discard the unwind protect for recovering the current
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4743 buffer. */
206ba2723812 (Fmd5): If OBJECT is a buffer different from the current
Kenichi Handa <handa@m17n.org>
parents: 53393
diff changeset
4744 specpdl_ptr--;
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4745
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4746 if (STRING_MULTIBYTE (object))
89483
2f877ed80fa6 *** empty log message ***
Kenichi Handa <handa@m17n.org>
parents: 88123 89309
diff changeset
4747 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4748 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4749
49246
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4750 md5_buffer (SDATA (object) + start_byte,
c1dbdec496c3 (Fsubstring): Clarify doc string.
Francesco Potortì <pot@gnu.org>
parents: 49204
diff changeset
4751 SBYTES (object) - (size_byte - end_byte),
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4752 digest);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4753
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4754 for (i = 0; i < 16; i++)
34106
89fd59727c6c (Fmd5): Use a different logic to decide the coding system
Gerd Moellmann <gerd@gnu.org>
parents: 34053
diff changeset
4755 sprintf (&value[2 * i], "%02x", digest[i]);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4756 value[32] = '\0';
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4757
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4758 return make_string (value, 32);
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4759 }
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4760
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4761
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
4762 void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4763 syms_of_fns (void)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4764 {
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4765 /* Hash table stuff. */
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4766 Qhash_table_p = intern_c_string ("hash-table-p");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4767 staticpro (&Qhash_table_p);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4768 Qeq = intern_c_string ("eq");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4769 staticpro (&Qeq);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4770 Qeql = intern_c_string ("eql");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4771 staticpro (&Qeql);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4772 Qequal = intern_c_string ("equal");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4773 staticpro (&Qequal);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4774 QCtest = intern_c_string (":test");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4775 staticpro (&QCtest);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4776 QCsize = intern_c_string (":size");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4777 staticpro (&QCsize);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4778 QCrehash_size = intern_c_string (":rehash-size");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4779 staticpro (&QCrehash_size);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4780 QCrehash_threshold = intern_c_string (":rehash-threshold");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4781 staticpro (&QCrehash_threshold);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4782 QCweakness = intern_c_string (":weakness");
25455
8c2f3438bb2c (QCweakness): Replaces QCweak.
Gerd Moellmann <gerd@gnu.org>
parents: 25365
diff changeset
4783 staticpro (&QCweakness);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4784 Qkey = intern_c_string ("key");
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4785 staticpro (&Qkey);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4786 Qvalue = intern_c_string ("value");
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4787 staticpro (&Qvalue);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4788 Qhash_table_test = intern_c_string ("hash-table-test");
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4789 staticpro (&Qhash_table_test);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4790 Qkey_or_value = intern_c_string ("key-or-value");
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4791 staticpro (&Qkey_or_value);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4792 Qkey_and_value = intern_c_string ("key-and-value");
30496
25d798a40775 (Qkey_or_value, Qkey_and_value): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 30488
diff changeset
4793 staticpro (&Qkey_and_value);
25005
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 defsubr (&Ssxhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4796 defsubr (&Smake_hash_table);
25365
f32071216123 (Qkey, Qvalue): Renamed from Qkey_weak, and Qvalue_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25349
diff changeset
4797 defsubr (&Scopy_hash_table);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4798 defsubr (&Shash_table_count);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4799 defsubr (&Shash_table_rehash_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4800 defsubr (&Shash_table_rehash_threshold);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4801 defsubr (&Shash_table_size);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4802 defsubr (&Shash_table_test);
25495
5051c1d824fa (Fhash_table_weakness): Replaces F_hash_table_weak.
Gerd Moellmann <gerd@gnu.org>
parents: 25455
diff changeset
4803 defsubr (&Shash_table_weakness);
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4804 defsubr (&Shash_table_p);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4805 defsubr (&Sclrhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4806 defsubr (&Sgethash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4807 defsubr (&Sputhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4808 defsubr (&Sremhash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4809 defsubr (&Smaphash);
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4810 defsubr (&Sdefine_hash_table_test);
30597
2cb00e0bf8d5 (Fmake_hash_table): Add missing `\n\' to end of line in docstring.
Noah Friedman <friedman@splode.com>
parents: 30510
diff changeset
4811
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4812 Qstring_lessp = intern_c_string ("string-lessp");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4813 staticpro (&Qstring_lessp);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4814 Qprovide = intern_c_string ("provide");
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
4815 staticpro (&Qprovide);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4816 Qrequire = intern_c_string ("require");
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
4817 staticpro (&Qrequire);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4818 Qyes_or_no_p_history = intern_c_string ("yes-or-no-p-history");
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
4819 staticpro (&Qyes_or_no_p_history);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4820 Qcursor_in_echo_area = intern_c_string ("cursor-in-echo-area");
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
4821 staticpro (&Qcursor_in_echo_area);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4822 Qwidget_type = intern_c_string ("widget-type");
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4823 staticpro (&Qwidget_type);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4824
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
4825 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
4826 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
4827
40474
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
4828 require_nesting_list = Qnil;
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
4829 staticpro (&require_nesting_list);
e8c25a61215d (Frequire): Detect recursive try to require the same
Richard M. Stallman <rms@gnu.org>
parents: 40132
diff changeset
4830
14486
3c4ba112108e (syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents: 14456
diff changeset
4831 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
4832
112364
42e22c4f06b7 Move all DEFVAR'd globals into a structure -- threading infrastructure
Tom Tromey <tromey@redhat.com>
parents: 112330
diff changeset
4833 DEFVAR_LISP ("features", Vfeatures,
73686
d2a970fd4273 (Ffeaturep, syms_of_fns): Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents: 73049
diff changeset
4834 doc: /* A list of symbols which are the features of the executing Emacs.
39899
34ec3a68775d Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39850
diff changeset
4835 Used by `featurep' and `require', and altered by `provide'. */);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4836 Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4837 Qsubfeatures = intern_c_string ("subfeatures");
39850
80b844540f64 (Ffeaturep): Add new `subfeature' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39697
diff changeset
4838 staticpro (&Qsubfeatures);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4839
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
4840 #ifdef HAVE_LANGINFO_CODESET
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4841 Qcodeset = intern_c_string ("codeset");
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
4842 staticpro (&Qcodeset);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4843 Qdays = intern_c_string ("days");
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
4844 staticpro (&Qdays);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4845 Qmonths = intern_c_string ("months");
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
4846 staticpro (&Qmonths);
105877
21bdda3ded62 * xterm.c (syms_of_xterm):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105683
diff changeset
4847 Qpaper = intern_c_string ("paper");
49081
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
4848 staticpro (&Qpaper);
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
4849 #endif /* HAVE_LANGINFO_CODESET */
bd4e0fb1fe78 Include coding.h. Use POINTER_TYPE*, not void*.
Dave Love <fx@gnu.org>
parents: 48596
diff changeset
4850
112364
42e22c4f06b7 Move all DEFVAR'd globals into a structure -- threading infrastructure
Tom Tromey <tromey@redhat.com>
parents: 112330
diff changeset
4851 DEFVAR_BOOL ("use-dialog-box", use_dialog_box,
39977
51c2b8f7aa5a Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4852 doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
44712
093bf061ef1d (use-dialog-box): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 44524
diff changeset
4853 This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
97454
68a4bf203661 (use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 97043
diff changeset
4854 invoked by mouse clicks and mouse menu items.
68a4bf203661 (use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 97043
diff changeset
4855
68a4bf203661 (use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 97043
diff changeset
4856 On some platforms, file selection dialogs are also enabled if this is
68a4bf203661 (use_dialog_box): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 97043
diff changeset
4857 non-nil. */);
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
4858 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
4859
112364
42e22c4f06b7 Move all DEFVAR'd globals into a structure -- threading infrastructure
Tom Tromey <tromey@redhat.com>
parents: 112330
diff changeset
4860 DEFVAR_BOOL ("use-file-dialog", use_file_dialog,
53189
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
4861 doc: /* *Non-nil means mouse commands use a file dialog to ask for files.
79868
9538ce91bacf (use_file_dialog): Doc fix.
Jason Rumney <jasonr@gnu.org>
parents: 79759
diff changeset
4862 This applies to commands from menus and tool bar buttons even when
104972
522f4ac8f10a * fns.c (syms_of_fns): Doc fix (Bug#4227).
Chong Yidong <cyd@stupidchicken.com>
parents: 104313
diff changeset
4863 they are initiated from the keyboard. If `use-dialog-box' is nil,
522f4ac8f10a * fns.c (syms_of_fns): Doc fix (Bug#4227).
Chong Yidong <cyd@stupidchicken.com>
parents: 104313
diff changeset
4864 that disables the use of a file dialog, regardless of the value of
522f4ac8f10a * fns.c (syms_of_fns): Doc fix (Bug#4227).
Chong Yidong <cyd@stupidchicken.com>
parents: 104313
diff changeset
4865 this variable. */);
53189
2c1d6f1a791e Add variable use-file-dialog to control use of file dialogs.
Jan Djärv <jan.h.d@swipnet.se>
parents: 53159
diff changeset
4866 use_file_dialog = 1;
53255
3b437add35b6 (Frandom, Fstring_make_multibyte): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53189
diff changeset
4867
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4868 defsubr (&Sidentity);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4869 defsubr (&Srandom);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4870 defsubr (&Slength);
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
4871 defsubr (&Ssafe_length);
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
4872 defsubr (&Sstring_bytes);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4873 defsubr (&Sstring_equal);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
4874 defsubr (&Scompare_strings);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4875 defsubr (&Sstring_lessp);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4876 defsubr (&Sappend);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4877 defsubr (&Sconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4878 defsubr (&Svconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4879 defsubr (&Scopy_sequence);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
4880 defsubr (&Sstring_make_multibyte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
4881 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
4882 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
4883 defsubr (&Sstring_as_unibyte);
49656
46090ea2c5c3 (string_to_multibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 49246
diff changeset
4884 defsubr (&Sstring_to_multibyte);
96248
a2307295cc84 (Fstring_to_unibyte): New function.
Kenichi Handa <handa@m17n.org>
parents: 94992
diff changeset
4885 defsubr (&Sstring_to_unibyte);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4886 defsubr (&Scopy_alist);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4887 defsubr (&Ssubstring);
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
4888 defsubr (&Ssubstring_no_properties);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4889 defsubr (&Snthcdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4890 defsubr (&Snth);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4891 defsubr (&Selt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4892 defsubr (&Smember);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4893 defsubr (&Smemq);
73029
8a6d7bd59539 (Fmemq): Refill doc string.
Kim F. Storm <storm@cua.dk>
parents: 72609
diff changeset
4894 defsubr (&Smemql);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4895 defsubr (&Sassq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4896 defsubr (&Sassoc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4897 defsubr (&Srassq);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
4898 defsubr (&Srassoc);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4899 defsubr (&Sdelq);
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
4900 defsubr (&Sdelete);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4901 defsubr (&Snreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4902 defsubr (&Sreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4903 defsubr (&Ssort);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
4904 defsubr (&Splist_get);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4905 defsubr (&Sget);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
4906 defsubr (&Splist_put);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4907 defsubr (&Sput);
44159
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
4908 defsubr (&Slax_plist_get);
61c15819e528 (Fsubstring_no_properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44066
diff changeset
4909 defsubr (&Slax_plist_put);
54987
1b818fd4a373 (Feql): New function.
John Paul Wallington <jpw@pobox.com>
parents: 54373
diff changeset
4910 defsubr (&Seql);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4911 defsubr (&Sequal);
54373
9685a42b7c56 (internal_equal): New arg PROPS controls comparing
Richard M. Stallman <rms@gnu.org>
parents: 53821
diff changeset
4912 defsubr (&Sequal_including_properties);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4913 defsubr (&Sfillarray);
52075
cda0be6a7138 (Fclear_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 51976
diff changeset
4914 defsubr (&Sclear_string);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4915 defsubr (&Snconc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4916 defsubr (&Smapcar);
28666
3408e0502727 (syms_of_fns): Defsubr mapc.
Dave Love <fx@gnu.org>
parents: 28555
diff changeset
4917 defsubr (&Smapc);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4918 defsubr (&Smapconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4919 defsubr (&Syes_or_no_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4920 defsubr (&Sload_average);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4921 defsubr (&Sfeaturep);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4922 defsubr (&Srequire);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4923 defsubr (&Sprovide);
29953
dad7b11391a3 (Fplist_member): Renamed from Fwidget_plist_member.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29809
diff changeset
4924 defsubr (&Splist_member);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4925 defsubr (&Swidget_put);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4926 defsubr (&Swidget_get);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
4927 defsubr (&Swidget_apply);
23208
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4928 defsubr (&Sbase64_encode_region);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4929 defsubr (&Sbase64_decode_region);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4930 defsubr (&Sbase64_encode_string);
1abc842b1ca7 (base64_decode_1, base64_encode_1): New functions.
Karl Heuer <kwzh@gnu.org>
parents: 23207
diff changeset
4931 defsubr (&Sbase64_decode_string);
34050
cc03857ce950 (Fmd5): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 33041
diff changeset
4932 defsubr (&Smd5);
51976
26f7a240c793 (Flocale_info): Renamed from Flanginfo. Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 51768
diff changeset
4933 defsubr (&Slocale_info);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4934 }
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4935
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4936
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4937 void
109126
aec1143e8d85 Convert (most) functions in src to standard C.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 109100
diff changeset
4938 init_fns (void)
25005
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4939 {
95eace73d3ef (toplevel): Add hash tables.
Gerd Moellmann <gerd@gnu.org>
parents: 24582
diff changeset
4940 }
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 52075
diff changeset
4941