annotate src/fns.c @ 23096:e4419c63d4d7

(message-send-mail-with-sendmail): Bind coding-system-for-write by the return value of select-message-coding-system. (message-send-mail-with-qmail): Likewise.
author Kenichi Handa <handa@m17n.org>
date Tue, 25 Aug 1998 10:25:03 +0000
parents 2dbf1ec20bf7
children 45de23c16505
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.
20706
d43ba5d91281 Update copyright year.
Richard M. Stallman <rms@gnu.org>
parents: 20699
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 1998 Free Software Foundation, Inc.
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 This file is part of GNU Emacs.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
8 the Free Software Foundation; either version 2, or (at your option)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 any later version.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU General Public License for more details.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 along with GNU Emacs; see the file COPYING. If not, write to
14186
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14097
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14097
diff changeset
19 Boston, MA 02111-1307, USA. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4616
diff changeset
22 #include <config.h>
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
24 #ifdef HAVE_UNISTD_H
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
25 #include <unistd.h>
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
26 #endif
21841
12c75f0ef578 Include <time.h> for time.
Andreas Schwab <schwab@suse.de>
parents: 21810
diff changeset
27 #include <time.h>
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
28
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29 /* Note on some machines this defines `vector' as a typedef,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 so make sure we don't use that name in this file. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 #undef vector
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
32 #define vector *****
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 #include "lisp.h"
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35 #include "commands.h"
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
36 #include "charset.h"
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38 #include "buffer.h"
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
39 #include "keyboard.h"
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
40 #include "intervals.h"
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
41 #include "frame.h"
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
42 #include "window.h"
21810
15f5abff4d9b [HAVE_MENUS]: Include xterm.h only if HAVE_X_WINDOWS.
Richard M. Stallman <rms@gnu.org>
parents: 21791
diff changeset
43 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS)
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
44 #include "xterm.h"
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
45 #endif
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46
12062
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
47 #ifndef NULL
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
48 #define NULL (void *)0
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
49 #endif
9d84af59f868 (NULL): Define if not defined.
Karl Heuer <kwzh@gnu.org>
parents: 12008
diff changeset
50
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
51 /* Nonzero enables use of dialog boxes for questions
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
52 asked by mouse commands. */
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
53 int use_dialog_box;
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
54
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
55 extern int minibuffer_auto_raise;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
56 extern Lisp_Object minibuf_window;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
57
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
58 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
59 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
60 Lisp_Object Qcursor_in_echo_area;
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
61 Lisp_Object Qwidget_type;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62
23051
18ed8d6b11e5 (Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents: 22853
diff changeset
63 extern Lisp_Object Qinput_method_function;
18ed8d6b11e5 (Fy_or_n_p): Bind input-method-function to nil.
Richard M. Stallman <rms@gnu.org>
parents: 22853
diff changeset
64
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
65 static int internal_equal ();
21580
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
66
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
67 extern long get_random ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
68 extern void seed_random ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
69
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
70 #ifndef HAVE_UNISTD_H
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
71 extern long time ();
061d5d4f7967 (time): Declare it only if not HAVE_UNISTD_H.
Richard M. Stallman <rms@gnu.org>
parents: 21577
diff changeset
72 #endif
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
73
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75 "Return the argument unchanged.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
77 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
78 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
79 return arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
80 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83 "Return a pseudo-random number.\n\
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
84 All integers representable in Lisp are equally likely.\n\
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
85 On most systems, this is 28 bits' worth.\n\
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
86 With positive integer argument N, return random number in interval [0,N).\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 With argument t, set the random number seed from the current time and pid.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
88 (n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
89 Lisp_Object n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 {
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
91 EMACS_INT val;
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
92 Lisp_Object lispy_val;
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
93 unsigned long denominator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
95 if (EQ (n, Qt))
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
96 seed_random (getpid () + time (NULL));
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
97 if (NATNUMP (n) && XFASTINT (n) != 0)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 {
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
99 /* 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
100 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
101 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
102 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
103 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
104 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
105 when using a large n. */
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
106 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (n);
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
107 do
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
108 val = get_random () / denominator;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
109 while (val >= XFASTINT (n));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110 }
6376
3fe339cf2dde (Frandom): Eliminate bias in random number generator.
Karl Heuer <kwzh@gnu.org>
parents: 6344
diff changeset
111 else
10485
40c59e55775a (Frandom): Call seed_random and get_random.
Karl Heuer <kwzh@gnu.org>
parents: 10411
diff changeset
112 val = get_random ();
12008
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
113 XSETINT (lispy_val, val);
637671248a31 (Frandom): Use EMACS_INT, not int.
Karl Heuer <kwzh@gnu.org>
parents: 11539
diff changeset
114 return lispy_val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 /* Random data-structure functions */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119 DEFUN ("length", Flength, Slength, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 "Return the length of vector, list or string SEQUENCE.\n\
19383
ca0fca5eb8c9 (Flength): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 19278
diff changeset
121 A byte-code function object is also allowed.\n\
ca0fca5eb8c9 (Flength): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 19278
diff changeset
122 If the string contains multibyte characters, this is not the necessarily\n\
21383
aa16b532cf4c (Flength): Doc fix.
Andreas Schwab <schwab@suse.de>
parents: 21374
diff changeset
123 the number of bytes in the string; it is the number of characters.\n\
aa16b532cf4c (Flength): Doc fix.
Andreas Schwab <schwab@suse.de>
parents: 21374
diff changeset
124 To get the number of bytes, use `string-bytes'")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
125 (sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
126 register Lisp_Object sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 register Lisp_Object tail, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131 retry:
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
132 if (STRINGP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
133 XSETFASTINT (val, XSTRING (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
134 else if (VECTORP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
135 XSETFASTINT (val, XVECTOR (sequence)->size);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
136 else if (CHAR_TABLE_P (sequence))
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
137 XSETFASTINT (val, (MIN_CHAR_COMPOSITION
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
138 + (CHAR_FIELD2_MASK | CHAR_FIELD3_MASK)
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
139 - 1));
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
140 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
141 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
142 else if (COMPILEDP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
143 XSETFASTINT (val, XVECTOR (sequence)->size & PSEUDOVECTOR_SIZE_MASK);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
144 else if (CONSP (sequence))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
146 for (i = 0, tail = sequence; !NILP (tail); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 tail = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151
9308
2c594629baaa (Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9289
diff changeset
152 XSETFASTINT (val, 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
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
157 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
158 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 }
9965
f68eab303ddb (Flength): Don't call Farray_length, just use size field.
Karl Heuer <kwzh@gnu.org>
parents: 9927
diff changeset
161 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
164 /* This does not check for quits. That is safe
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
165 since it must terminate. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
166
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
167 DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
168 "Return the length of a list, but avoid error or infinite loop.\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
169 This function never gets an error. If LIST is not really a list,\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
170 it returns 0. If LIST is circular, it returns a finite value\n\
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
171 which is at least the number of distinct elements.")
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
172 (list)
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
173 Lisp_Object list;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
174 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
175 Lisp_Object tail, halftail, length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
176 int len = 0;
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 /* halftail is used to detect circular lists. */
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
179 halftail = list;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
180 for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
181 {
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
182 if (EQ (tail, halftail) && len != 0)
12618
60c4c0fee545 (Fsafe_length): Use conservative upper bound.
Karl Heuer <kwzh@gnu.org>
parents: 12466
diff changeset
183 break;
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
184 len++;
13344
30e17254a280 (Fsafe_length): Add missing parentheses around & within comparison.
Richard M. Stallman <rms@gnu.org>
parents: 13277
diff changeset
185 if ((len & 1) == 0)
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
186 halftail = XCONS (halftail)->cdr;
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
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
189 XSETINT (length, len);
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
190 return length;
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
191 }
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
192
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
193 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
194 "Return the number of bytes in STRING.\n\
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
195 If STRING is a multibyte string, this is greater than the length of STRING.")
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
196 (string)
20881
fd35cf0efd94 (Fstring_bytes): Declare arg STRING as Lisp_Object.
Kenichi Handa <handa@m17n.org>
parents: 20880
diff changeset
197 Lisp_Object string;
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
198 {
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
199 CHECK_STRING (string, 1);
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
200 return make_number (STRING_BYTES (XSTRING (string)));
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
201 }
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
202
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
203 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
204 "Return t if two strings have identical contents.\n\
10114
6f6db8f5b8a0 (internal_equal): Call compare_string_intervals.
Richard M. Stallman <rms@gnu.org>
parents: 10059
diff changeset
205 Case is significant, but text properties are ignored.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
206 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
207 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
208 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
209 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
210 if (SYMBOLP (s1))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
211 XSETSTRING (s1, XSYMBOL (s1)->name);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
212 if (SYMBOLP (s2))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
213 XSETSTRING (s2, XSYMBOL (s2)->name);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
217 if (XSTRING (s1)->size != XSTRING (s2)->size
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
218 || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2))
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
219 || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1))))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
224 DEFUN ("compare-strings", Fcompare_strings,
21673
8a32bf93da04 (Fcompare_strings): Require first 6 args.
Richard M. Stallman <rms@gnu.org>
parents: 21671
diff changeset
225 Scompare_strings, 6, 7, 0,
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
226 "Compare the contents of two strings, converting to multibyte if needed.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
227 In string STR1, skip the first START1 characters and stop at END1.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
228 In string STR2, skip the first START2 characters and stop at END2.\n\
21789
c7b93fe649d4 (Fcompare_strings): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21716
diff changeset
229 END1 and END2 default to the full lengths of the respective strings.\n\
c7b93fe649d4 (Fcompare_strings): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21716
diff changeset
230 \n\
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
231 Case is significant in this comparison if IGNORE-CASE is nil.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
232 Unibyte strings are converted to multibyte for comparison.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
233 \n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
234 The value is t if the strings (or specified portions) match.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
235 If string STR1 is less, the value is a negative number N;\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
236 - 1 - N is the number of characters that match at the beginning.\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
237 If string STR1 is greater, the value is a positive number N;\n\
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
238 N - 1 is the number of characters that match at the beginning.")
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
239 (str1, start1, end1, str2, start2, end2, ignore_case)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
240 Lisp_Object str1, start1, end1, start2, str2, end2, ignore_case;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
241 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
242 register int end1_char, end2_char;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
243 register int i1, i1_byte, i2, i2_byte;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
244
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
245 CHECK_STRING (str1, 0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
246 CHECK_STRING (str2, 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
247 if (NILP (start1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
248 start1 = make_number (0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
249 if (NILP (start2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
250 start2 = make_number (0);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
251 CHECK_NATNUM (start1, 2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
252 CHECK_NATNUM (start2, 3);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
253 if (! NILP (end1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
254 CHECK_NATNUM (end1, 4);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
255 if (! NILP (end2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
256 CHECK_NATNUM (end2, 4);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
257
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
258 i1 = XINT (start1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
259 i2 = XINT (start2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
260
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
261 i1_byte = string_char_to_byte (str1, i1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
262 i2_byte = string_char_to_byte (str2, i2);
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 end1_char = XSTRING (str1)->size;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
265 if (! NILP (end1) && end1_char > XINT (end1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
266 end1_char = XINT (end1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
267
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
268 end2_char = XSTRING (str2)->size;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
269 if (! NILP (end2) && end2_char > XINT (end2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
270 end2_char = XINT (end2);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
271
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
272 while (i1 < end1_char && i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
273 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
274 /* When we find a mismatch, we must compare the
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
275 characters, not just the bytes. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
276 int c1, c2;
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 (str1))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
279 FETCH_STRING_CHAR_ADVANCE (c1, str1, i1, i1_byte);
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 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
282 c1 = XSTRING (str1)->data[i1++];
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
283 c1 = unibyte_char_to_multibyte (c1);
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 (STRING_MULTIBYTE (str2))
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
287 FETCH_STRING_CHAR_ADVANCE (c2, str2, i2, i2_byte);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
288 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
289 {
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
290 c2 = XSTRING (str2)->data[i2++];
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
291 c2 = unibyte_char_to_multibyte (c2);
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
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
294 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
295 continue;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
296
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
297 if (! NILP (ignore_case))
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 Lisp_Object tem;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
300
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
301 tem = Fupcase (make_number (c1));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
302 c1 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
303 tem = Fupcase (make_number (c2));
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
304 c2 = XINT (tem);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
305 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
306
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
307 if (c1 == c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
308 continue;
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 /* Note that I1 has already been incremented
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
311 past the character that we are comparing;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
312 hence we don't add or subtract 1 here. */
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
313 if (c1 < c2)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
314 return make_number (- i1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
315 else
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
316 return make_number (i1);
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
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
319 if (i1 < end1_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
320 return make_number (i1 - XINT (start1) + 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
321 if (i2 < end2_char)
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
322 return make_number (- i1 + XINT (start1) - 1);
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
323
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
324 return Qt;
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
325 }
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
326
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
327 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
328 "Return t if first arg string is less than second in lexicographic order.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
329 Case is significant.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
330 Symbols are also allowed; their print names are used instead.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
331 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
332 register Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
333 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334 register int end;
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
335 register int i1, i1_byte, i2, i2_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
336
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
337 if (SYMBOLP (s1))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
338 XSETSTRING (s1, XSYMBOL (s1)->name);
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
339 if (SYMBOLP (s2))
9289
e5a850de0ba8 (Fstring_equal, Fstring_lessp): Delete now-redundant XSETTYPE.
Karl Heuer <kwzh@gnu.org>
parents: 9128
diff changeset
340 XSETSTRING (s2, XSYMBOL (s2)->name);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
341 CHECK_STRING (s1, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
342 CHECK_STRING (s2, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
343
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
344 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
345
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
346 end = XSTRING (s1)->size;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
347 if (end > XSTRING (s2)->size)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
348 end = XSTRING (s2)->size;
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 while (i1 < end)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
351 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
352 /* 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
353 characters, not just the bytes. */
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
354 int c1, c2;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
356 if (STRING_MULTIBYTE (s1))
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
357 FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
358 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
359 c1 = XSTRING (s1)->data[i1++];
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
360
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
361 if (STRING_MULTIBYTE (s2))
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
362 FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
363 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
364 c2 = XSTRING (s2)->data[i2++];
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
365
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
366 if (c1 != c2)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
367 return c1 < c2 ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
369 return i1 < XSTRING (s2)->size ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 static Lisp_Object concat ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
375 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
376 concat2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
378 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383 return concat (2, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385 return concat (2, &s1, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
387 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388
8966
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
389 /* ARGSUSED */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
390 Lisp_Object
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
391 concat3 (s1, s2, s3)
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
392 Lisp_Object s1, s2, s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
393 {
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
394 #ifdef NO_ARG_ARRAY
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
395 Lisp_Object args[3];
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
396 args[0] = s1;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
397 args[1] = s2;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
398 args[2] = s3;
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
399 return concat (3, args, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
400 #else
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
401 return concat (3, &s1, Lisp_String, 0);
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
402 #endif /* NO_ARG_ARRAY */
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
403 }
cafc16f356c2 (concat3): New function.
Richard M. Stallman <rms@gnu.org>
parents: 8901
diff changeset
404
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
405 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406 "Concatenate all the arguments and make the result a list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 The result is a list whose elements are the elements of all the arguments.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408 Each argument may be a list, vector or string.\n\
1037
c17a6750293c (Fappend): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 866
diff changeset
409 The last argument is not copied, just used as the tail of the new list.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
414 return concat (nargs, args, Lisp_Cons, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
416
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 "Concatenate all the arguments and make the result a string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 The result is a string whose elements are the elements of all the arguments.\n\
11142
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
420 Each argument may be a string or a list or vector of characters (integers).\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
421 \n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
422 Do not use individual integers as arguments!\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
423 The behavior of `concat' in that case will be changed later!\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
424 If your program passes an integer as an argument to `concat',\n\
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
425 you should change it right away not to do so.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 return concat (nargs, args, Lisp_String, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
431 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
432
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434 "Concatenate all the arguments and make the result a vector.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 The result is a vector whose elements are the elements of all the arguments.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
436 Each argument may be a list, vector or string.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
439 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 {
10006
402c87cbc4fa (Fvconcat, concat): Use Lisp_Vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9965
diff changeset
441 return concat (nargs, args, Lisp_Vectorlike, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
444 /* Retrun a copy of a sub char table ARG. The elements except for a
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
445 nested sub char table are not copied. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
446 static Lisp_Object
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
447 copy_sub_char_table (arg)
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
448 Lisp_Object arg;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
449 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
450 Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
451 int i;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
452
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
453 /* Copy all the contents. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
454 bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
455 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
456 /* Recursively copy any sub char-tables in the ordinary slots. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
457 for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
458 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
459 XCHAR_TABLE (copy)->contents[i]
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
460 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
461
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
462 return copy;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
463 }
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
464
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
465
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
466 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
467 "Return a copy of a list, vector or string.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
468 The elements of a list or vector are not copied; they are shared\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
469 with the original.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
470 (arg)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
471 Lisp_Object arg;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
472 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
473 if (NILP (arg)) return arg;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
474
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
475 if (CHAR_TABLE_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
476 {
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
477 int i;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
478 Lisp_Object copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
479
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
480 copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
481 /* Copy all the slots, including the extra ones. */
17819
6fd66459ec9a (Fcopy_sequence): Correctly copy the char-table contents.
Richard M. Stallman <rms@gnu.org>
parents: 17789
diff changeset
482 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
483 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
484 * sizeof (Lisp_Object)));
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
485
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
486 /* Recursively copy any sub char tables in the ordinary slots
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
487 for multibyte characters. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
488 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
489 i < CHAR_TABLE_ORDINARY_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
490 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
491 XCHAR_TABLE (copy)->contents[i]
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
492 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
493
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
494 return copy;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
495 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
496
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
497 if (BOOL_VECTOR_P (arg))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
498 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
499 Lisp_Object val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
500 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
501 = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
502
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
503 val = Fmake_bool_vector (Flength (arg), Qnil);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
504 bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
505 size_in_chars);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
506 return val;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
507 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
508
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
509 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 arg = wrong_type_argument (Qsequencep, arg);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
512 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
513
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
514 static Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
515 concat (nargs, args, target_type, last_special)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
517 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 enum Lisp_Type target_type;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
519 int last_special;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
521 Lisp_Object val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
522 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
523 register Lisp_Object this;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524 int toindex;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
525 int toindex_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
526 register int result_len;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
527 register int result_len_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529 Lisp_Object last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
530 Lisp_Object prev;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
531 int some_multibyte;
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
532 /* When we make a multibyte string, we must pay attention to the
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
533 byte combining problem, i.e., a byte may be combined with a
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
534 multibyte charcter of the previous string. This flag tells if we
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
535 must consider such a situation or not. */
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
536 int maybe_combine_byte;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
538 /* In append, the last arg isn't treated like the others */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539 if (last_special && nargs > 0)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
540 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
541 nargs--;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
542 last_tail = args[nargs];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
543 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
544 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
545 last_tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
546
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
547 /* Canonicalize each argument. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
548 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
549 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550 this = args[argnum];
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
551 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
552 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
553 {
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
554 if (INTEGERP (this))
11142
41b869bbe0e1 (Fconcat): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 11138
diff changeset
555 args[argnum] = Fnumber_to_string (this);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
556 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
557 args[argnum] = wrong_type_argument (Qsequencep, this);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
558 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
559 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
560
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
561 /* 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
562 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
563 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
564 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
565 result_len_byte = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
566 result_len = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
567 some_multibyte = 0;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
568 for (argnum = 0; argnum < nargs; argnum++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
569 {
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
570 int len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
571 this = args[argnum];
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
572 len = XFASTINT (Flength (this));
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
573 if (target_type == Lisp_String)
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
574 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
575 /* 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
576 as well as the number of characters. */
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
577 int i;
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
578 Lisp_Object ch;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
579 int this_len_byte;
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
580
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
581 if (VECTORP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
582 for (i = 0; i < len; i++)
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
583 {
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
584 ch = XVECTOR (this)->contents[i];
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
585 if (! INTEGERP (ch))
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
586 wrong_type_argument (Qintegerp, ch);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
587 this_len_byte = XFASTINT (Fchar_bytes (ch));
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
588 result_len_byte += this_len_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
589 if (this_len_byte > 1)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
590 some_multibyte = 1;
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
591 }
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
592 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
593 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
594 else if (CONSP (this))
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
595 for (; CONSP (this); this = XCONS (this)->cdr)
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
596 {
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
597 ch = XCONS (this)->car;
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
598 if (! INTEGERP (ch))
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
599 wrong_type_argument (Qintegerp, ch);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
600 this_len_byte = XFASTINT (Fchar_bytes (ch));
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
601 result_len_byte += this_len_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
602 if (this_len_byte > 1)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
603 some_multibyte = 1;
19278
50f47ef6ce9a (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 19223
diff changeset
604 }
20639
12240a9b3679 (concat): Check STRINGP before increasing result_len_byte.
Kenichi Handa <handa@m17n.org>
parents: 20607
diff changeset
605 else if (STRINGP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
606 {
20699
907d8633c8cc (concat): Use unibyte_char_to_multibyte.
Richard M. Stallman <rms@gnu.org>
parents: 20667
diff changeset
607 if (STRING_MULTIBYTE (this))
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
608 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
609 some_multibyte = 1;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
610 result_len_byte += STRING_BYTES (XSTRING (this));
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
611 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
612 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
613 result_len_byte += count_size_as_multibyte (XSTRING (this)->data,
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
614 XSTRING (this)->size);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
615 }
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
616 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
617
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
618 result_len += len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
619 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
620
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
621 if (! some_multibyte)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
622 result_len_byte = result_len;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
623
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
624 /* Create the output object. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
625 if (target_type == Lisp_Cons)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
626 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
627 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
628 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
629 else if (some_multibyte)
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
630 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
631 else
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
632 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
633
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
634 /* 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
635 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
636 return last_tail;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
637
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
638 /* Copy the contents of the args into the result. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
639 if (CONSP (val))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
640 tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
641 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
642 toindex = 0, toindex_byte = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
643
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
644 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
645
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
646 maybe_combine_byte = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
647 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
648 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
649 Lisp_Object thislen;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
650 int thisleni;
16863
591b7a95d7a5 (concat): Take modulus of thisindex before shifting.
Richard M. Stallman <rms@gnu.org>
parents: 16561
diff changeset
651 register unsigned int thisindex = 0;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
652 register unsigned int thisindex_byte = 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
653
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
654 this = args[argnum];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
655 if (!CONSP (this))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
656 thislen = Flength (this), thisleni = XINT (thislen);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
657
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
658 if (STRINGP (this) && STRINGP (val)
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
659 && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
660 copy_text_properties (make_number (0), thislen, this,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
661 make_number (toindex), val, Qnil);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
662
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
663 /* 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
664 if (STRINGP (this) && STRINGP (val)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
665 && 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
666 {
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
667 int thislen_byte = STRING_BYTES (XSTRING (this));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
668 bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
669 STRING_BYTES (XSTRING (this)));
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
670 if (some_multibyte
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
671 && toindex_byte > 0
22711
ed021e36c5f9 (concat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents: 22706
diff changeset
672 && !ASCII_BYTE_P (XSTRING (val)->data[toindex_byte - 1])
22853
62d2fb895f5f (concat): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 22721
diff changeset
673 && !CHAR_HEAD_P (XSTRING (this)->data[0]))
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
674 maybe_combine_byte = 1;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
675 toindex_byte += thislen_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
676 toindex += thisleni;
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
677 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
678 /* 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
679 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
680 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
681 toindex_byte += copy_text (XSTRING (this)->data,
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
682 XSTRING (val)->data + toindex_byte,
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
683 XSTRING (this)->size, 0, 1);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
684 toindex += thisleni;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
685 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
686 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
687 /* Copy element by element. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
688 while (1)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
689 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
690 register Lisp_Object elt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
691
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
692 /* 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
693 `this' is exhausted. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
694 if (NILP (this)) break;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
695 if (CONSP (this))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
696 elt = XCONS (this)->car, this = XCONS (this)->cdr;
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
697 else if (thisindex >= thisleni)
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
698 break;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
699 else if (STRINGP (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
700 {
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
701 int c;
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
702 if (STRING_MULTIBYTE (this))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
703 {
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
704 FETCH_STRING_CHAR_ADVANCE (c, this,
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
705 thisindex,
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
706 thisindex_byte);
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
707 XSETFASTINT (elt, c);
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
708 }
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
709 else
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
710 {
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
711 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
712 if (some_multibyte && XINT (elt) >= 0200
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
713 && XINT (elt) < 0400)
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
714 {
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
715 c = unibyte_char_to_multibyte (XINT (elt));
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
716 XSETINT (elt, c);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
717 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
718 }
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
719 }
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
720 else if (BOOL_VECTOR_P (this))
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
721 {
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
722 int byte;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
723 byte = XBOOL_VECTOR (this)->data[thisindex / BITS_PER_CHAR];
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
724 if (byte & (1 << (thisindex % BITS_PER_CHAR)))
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
725 elt = Qt;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
726 else
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
727 elt = Qnil;
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
728 thisindex++;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
729 }
20814
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
730 else
8f6d92b4f48a (concat): Handle bool-vectors correctly.
Richard M. Stallman <rms@gnu.org>
parents: 20813
diff changeset
731 elt = XVECTOR (this)->contents[thisindex++];
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
732
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
733 /* Store this element into the result. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
734 if (toindex < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
735 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
736 XCONS (tail)->car = elt;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
737 prev = tail;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
738 tail = XCONS (tail)->cdr;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
739 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
740 else if (VECTORP (val))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
741 XVECTOR (val)->contents[toindex++] = elt;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
742 else
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
743 {
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
744 CHECK_NUMBER (elt, 0);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
745 if (SINGLE_BYTE_CHAR_P (XINT (elt)))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
746 {
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
747 if (some_multibyte
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
748 && toindex_byte > 0
22711
ed021e36c5f9 (concat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents: 22706
diff changeset
749 && !ASCII_BYTE_P (XSTRING (val)->data[toindex_byte - 1])
ed021e36c5f9 (concat): Replace explicit numeric constants with proper macros.
Kenichi Handa <handa@m17n.org>
parents: 22706
diff changeset
750 && !CHAR_HEAD_P (XINT (elt)))
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
751 maybe_combine_byte = 1;
22117
c6b783988569 (concat): Fix bug in concatinating a list of multibyte and
Kenichi Handa <handa@m17n.org>
parents: 21841
diff changeset
752 XSTRING (val)->data[toindex_byte++] = XINT (elt);
c6b783988569 (concat): Fix bug in concatinating a list of multibyte and
Kenichi Handa <handa@m17n.org>
parents: 21841
diff changeset
753 toindex++;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
754 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
755 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
756 /* If we have any multibyte characters,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
757 we already decided to make a multibyte string. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
758 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
759 int c = XINT (elt);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
760 unsigned char work[4], *str;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
761 int i = CHAR_STRING (c, work, str);
18311
8b716cb12cdd (concat): Pay attention to multibyte characters when
Kenichi Handa <handa@m17n.org>
parents: 18108
diff changeset
762
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
763 /* P exists as a variable
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
764 to avoid a bug on the Masscomp C compiler. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
765 unsigned char *p = & XSTRING (val)->data[toindex_byte];
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
766 bcopy (str, p, i);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
767 toindex_byte += i;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
768 toindex++;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
769 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
770 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
771 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
772 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
773 if (!NILP (prev))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
774 XCONS (prev)->cdr = last_tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
775
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
776 if (maybe_combine_byte)
22721
d023df160219 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 22711
diff changeset
777 /* Character counter of the multibyte string VAL may be wrong
22696
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
778 because of byte combining problem. We must re-calculate it. */
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
779 XSTRING (val)->size = multibyte_chars_in_text (XSTRING (val)->data,
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
780 XSTRING (val)->size_byte);
56847e28cc45 (concat): Pay attention to the byte combining problem.
Kenichi Handa <handa@m17n.org>
parents: 22165
diff changeset
781
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
782 return val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
783 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
784
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
785 static Lisp_Object string_char_byte_cache_string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
786 static int string_char_byte_cache_charpos;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
787 static int string_char_byte_cache_bytepos;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
788
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
789 /* Return the character index corresponding to CHAR_INDEX in STRING. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
790
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
791 int
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
792 string_char_to_byte (string, char_index)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
793 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
794 int char_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
795 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
796 int i, i_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
797 int best_below, best_below_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
798 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
799
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
800 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
801 return char_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
802
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
803 best_below = best_below_byte = 0;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
804 best_above = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
805 best_above_byte = STRING_BYTES (XSTRING (string));
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
806
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
807 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
808 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
809 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
810 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
811 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
812 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
813 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
814 else
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 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
817 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
818 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
819 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
820
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
821 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
822 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
823 while (best_below < char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
824 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
825 int c;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
826 FETCH_STRING_CHAR_ADVANCE (c, string, best_below, best_below_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
827 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
828 i = best_below;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
829 i_byte = best_below_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
830 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
831 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
832 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
833 while (best_above > char_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
834 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
835 int best_above_byte_saved = --best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
836
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
837 while (best_above_byte > 0
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
838 && !CHAR_HEAD_P (XSTRING (string)->data[best_above_byte]))
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
839 best_above_byte--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
840 if (XSTRING (string)->data[best_above_byte] < 0x80)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
841 best_above_byte = best_above_byte_saved;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
842 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
843 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
844 i = best_above;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
845 i_byte = best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
846 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
847
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
848 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
849 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
850 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
851
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
852 return i_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
853 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
854
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
855 /* 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
856
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
857 int
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
858 string_byte_to_char (string, byte_index)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
859 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
860 int byte_index;
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 int i, i_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
863 int best_below, best_below_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
864 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
865
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
866 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
867 return byte_index;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
868
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
869 best_below = best_below_byte = 0;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
870 best_above = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
871 best_above_byte = STRING_BYTES (XSTRING (string));
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
872
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
873 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
874 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
875 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
876 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
877 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
878 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
879 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
880 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
881 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
882 best_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
883 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
884 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
885 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
886
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
887 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
888 {
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
889 while (best_below_byte < byte_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
890 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
891 int c;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
892 FETCH_STRING_CHAR_ADVANCE (c, string, best_below, best_below_byte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
893 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
894 i = best_below;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
895 i_byte = best_below_byte;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
896 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
897 else
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
898 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
899 while (best_above_byte > byte_index)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
900 {
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
901 int best_above_byte_saved = --best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
902
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
903 while (best_above_byte > 0
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
904 && !CHAR_HEAD_P (XSTRING (string)->data[best_above_byte]))
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
905 best_above_byte--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
906 if (XSTRING (string)->data[best_above_byte] < 0x80)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
907 best_above_byte = best_above_byte_saved;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
908 best_above--;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
909 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
910 i = best_above;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
911 i_byte = best_above_byte;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
912 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
913
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
914 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
915 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
916 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
917
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
918 return i;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
919 }
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
920
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
921 /* Convert STRING to a multibyte string.
21029
3f47b0364c2a (DEFAULT_NONASCII_INSERT_OFFSET): Macro definition is
Kenichi Handa <handa@m17n.org>
parents: 21021
diff changeset
922 Single-byte characters 0240 through 0377 are converted
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
923 by adding nonascii_insert_offset to each. */
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
924
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
925 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
926 string_make_multibyte (string)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
927 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
928 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
929 unsigned char *buf;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
930 int nbytes;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
931
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
932 if (STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
933 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
934
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
935 nbytes = count_size_as_multibyte (XSTRING (string)->data,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
936 XSTRING (string)->size);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
937 /* 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
938 once converted. In that case, we can return STRING itself. */
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
939 if (nbytes == STRING_BYTES (XSTRING (string)))
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
940 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
941
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
942 buf = (unsigned char *) alloca (nbytes);
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
943 copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
944 0, 1);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
945
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
946 return make_multibyte_string (buf, XSTRING (string)->size, nbytes);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
947 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
948
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
949 /* 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
950
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
951 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
952 string_make_unibyte (string)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
953 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
954 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
955 unsigned char *buf;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
956
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
957 if (! STRING_MULTIBYTE (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
958 return string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
959
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
960 buf = (unsigned char *) alloca (XSTRING (string)->size);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
961
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
962 copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
963 1, 0);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
964
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
965 return make_unibyte_string (buf, XSTRING (string)->size);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
966 }
20667
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 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
969 1, 1, 0,
21716
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
970 "Return the multibyte equivalent of STRING.\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
971 The function `unibyte-char-to-multibyte' is used to convert\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
972 each unibyte character to a multibyte character.")
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
973 (string)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
974 Lisp_Object string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
975 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
976 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
977
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
978 return string_make_multibyte (string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
979 }
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
980
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
981 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
982 1, 1, 0,
21716
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
983 "Return the unibyte equivalent of STRING.\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
984 Multibyte character codes are converted to unibyte\n\
254857cf599c (Fstring_make_multibyte): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21673
diff changeset
985 by using just the low 8 bits.")
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
986 (string)
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
987 Lisp_Object string;
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
988 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
989 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
990
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
991 return string_make_unibyte (string);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
992 }
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
993
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
994 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
995 1, 1, 0,
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
996 "Return a unibyte string with the same individual bytes as STRING.\n\
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
997 If STRING is unibyte, the result is STRING itself.")
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
998 (string)
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
999 Lisp_Object string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1000 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1001 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1002
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1003 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
1004 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1005 string = Fcopy_sequence (string);
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1006 XSTRING (string)->size = STRING_BYTES (XSTRING (string));
21374
456146137d23 (Fstring_as_unibyte): Set size_byte field to -1.
Kenichi Handa <handa@m17n.org>
parents: 21342
diff changeset
1007 SET_STRING_BYTES (XSTRING (string), -1);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1008 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1009 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1010 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1011
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1012 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
1013 1, 1, 0,
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1014 "Return a multibyte string with the same individual bytes as STRING.\n\
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1015 If STRING is multibyte, the result is STRING itself.")
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1016 (string)
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1017 Lisp_Object string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1018 {
22165
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1019 CHECK_STRING (string, 0);
8cdacecac78b (Fstring_make_multibyte): Call CHECK_STRING.
Kenichi Handa <handa@m17n.org>
parents: 22117
diff changeset
1020
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1021 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
1022 {
21342
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1023 int nbytes = STRING_BYTES (XSTRING (string));
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1024 int newlen = multibyte_chars_in_text (XSTRING (string)->data, nbytes);
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1025
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1026 string = Fcopy_sequence (string);
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1027 XSTRING (string)->size = newlen;
efdf4fe4875b (Fstring_as_multibyte): Never return unibyte string unchanged.
Richard M. Stallman <rms@gnu.org>
parents: 21339
diff changeset
1028 XSTRING (string)->size_byte = nbytes;
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1029 }
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1030 return string;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1031 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1032
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1033 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1034 "Return a copy of ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1035 This is an alist which represents the same mapping from objects to objects,\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1036 but does not share the alist structure with ALIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1037 The objects mapped (cars and cdrs of elements of the alist)\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1038 are shared, however.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1039 Elements of ALIST that are not conses are also shared.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1040 (alist)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1041 Lisp_Object alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1042 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1043 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1044
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1045 CHECK_LIST (alist, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1046 if (NILP (alist))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1047 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1048 alist = concat (1, &alist, Lisp_Cons, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1049 for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1050 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1051 register Lisp_Object car;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1052 car = XCONS (tem)->car;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1053
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1054 if (CONSP (car))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1055 XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1056 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 return alist;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1058 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1059
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1060 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1061 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1062 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1063 If FROM or TO is negative, it counts from the end.\n\
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1064 \n\
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1065 This function allows vectors as well as strings.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1066 (string, from, to)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1067 Lisp_Object string;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1068 register Lisp_Object from, to;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1069 {
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1070 Lisp_Object res;
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1071 int size;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1072 int size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1073 int from_char, to_char;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1074 int from_byte, to_byte;
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1075
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1076 if (! (STRINGP (string) || VECTORP (string)))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1077 wrong_type_argument (Qarrayp, string);
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1078
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1079 CHECK_NUMBER (from, 1);
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1080
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1081 if (STRINGP (string))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1082 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1083 size = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1084 size_byte = STRING_BYTES (XSTRING (string));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1085 }
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1086 else
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1087 size = XVECTOR (string)->size;
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1088
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1089 if (NILP (to))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1090 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1091 to_char = size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1092 to_byte = size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1093 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1094 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1095 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1096 CHECK_NUMBER (to, 2);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1097
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1098 to_char = XINT (to);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1099 if (to_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1100 to_char += size;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1101
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1102 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1103 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
1104 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1105
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1106 from_char = XINT (from);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1107 if (from_char < 0)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1108 from_char += size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1109 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1110 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
1111
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1112 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
1113 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
1114 make_number (to_char));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1115
15966
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1116 if (STRINGP (string))
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1117 {
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1118 res = make_specified_string (XSTRING (string)->data + from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1119 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
1120 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1121 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
1122 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
1123 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1124 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1125 res = Fvector (to_char - from_char,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1126 XVECTOR (string)->contents + from_char);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1127
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1128 return res;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1129 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1130
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1131 /* 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
1132 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
1133
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1134 Lisp_Object
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1135 substring_both (string, from, from_byte, to, to_byte)
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1136 Lisp_Object string;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1137 int from, from_byte, to, to_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1138 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1139 Lisp_Object res;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1140 int size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1141 int size_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1142
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1143 if (! (STRINGP (string) || VECTORP (string)))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1144 wrong_type_argument (Qarrayp, string);
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1145
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1146 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1147 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1148 size = XSTRING (string)->size;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1149 size_byte = STRING_BYTES (XSTRING (string));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1150 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1151 else
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1152 size = XVECTOR (string)->size;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1153
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1154 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
1155 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
1156
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1157 if (STRINGP (string))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1158 {
21260
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1159 res = make_specified_string (XSTRING (string)->data + from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1160 to - from, to_byte - from_byte,
4ac9ba6e745d (substring_both, Fsubstring): Use make_specified_string.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
1161 STRING_MULTIBYTE (string));
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1162 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
1163 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
1164 }
ceb8d03a04f6 (Fsubstring): Handle vectors as well as strings.
Richard M. Stallman <rms@gnu.org>
parents: 15713
diff changeset
1165 else
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1166 res = Fvector (to - from,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1167 XVECTOR (string)->contents + from);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1168
4004
71541ea16adf * fns.c (Fsubstring, concat): Pass all six arguments to
Jim Blandy <jimb@redhat.com>
parents: 3379
diff changeset
1169 return res;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1170 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1171
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1172 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1173 "Take cdr N times on LIST, returns the result.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1174 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1175 Lisp_Object n;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1176 register Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1177 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1178 register int i, num;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1179 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1180 num = XINT (n);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1181 for (i = 0; i < num && !NILP (list); i++)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1182 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1183 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1184 list = Fcdr (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1185 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1186 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1187 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1188
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1189 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1190 "Return the Nth element of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1191 N counts from zero. If LIST is not that long, nil is returned.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1192 (n, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1193 Lisp_Object n, list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1194 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1195 return Fcar (Fnthcdr (n, list));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1196 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1197
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1198 DEFUN ("elt", Felt, Selt, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1199 "Return element of SEQUENCE at index N.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1200 (sequence, n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1201 register Lisp_Object sequence, n;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1202 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1203 CHECK_NUMBER (n, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1204 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1205 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1206 if (CONSP (sequence) || NILP (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1207 return Fcar (Fnthcdr (n, sequence));
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1208 else if (STRINGP (sequence) || VECTORP (sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1209 || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1210 return Faref (sequence, n);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211 else
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1212 sequence = wrong_type_argument (Qsequencep, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1213 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1214 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1215
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1216 DEFUN ("member", Fmember, Smember, 2, 2, 0,
6990
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1217 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1218 The value is actually the tail of LIST whose car is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1219 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1220 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1221 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1222 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1223 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1224 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1225 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1226 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1227 tem = Fcar (tail);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1228 if (! NILP (Fequal (elt, tem)))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1229 return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1230 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1231 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1232 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1233 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1234
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1235 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1236 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1237 The value is actually the tail of LIST whose car is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1238 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1239 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1240 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1241 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1242 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1243 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1244 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1245 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1246 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1247 if (EQ (elt, tem)) return tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1248 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1249 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1250 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1251 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1252
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1253 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
1254 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
1255 The value is actually the element of LIST whose car is KEY.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1256 Elements of LIST that are not conses are ignored.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1257 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1258 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1259 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1260 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1261 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1262 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1263 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1264 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1265 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1266 if (!CONSP (elt)) continue;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1267 tem = XCONS (elt)->car;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1268 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1269 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1270 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1271 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1272 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1273
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1274 /* Like Fassq but never report an error and do not allow quits.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1275 Use only on lists known never to be circular. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1276
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1277 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1278 assq_no_quit (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1279 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1280 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1281 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1282 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1283 for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1284 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1285 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1286 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1287 if (!CONSP (elt)) continue;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1288 tem = XCONS (elt)->car;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1289 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1290 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1291 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1292 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1293
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1294 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
5661
066830a71a63 (Fassq, Fassoc): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 5437
diff changeset
1295 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1296 The value is actually the element of LIST whose car equals KEY.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1297 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1298 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1299 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1300 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1301 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1302 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
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 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1305 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1306 if (!CONSP (elt)) continue;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1307 tem = Fequal (XCONS (elt)->car, key);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1308 if (!NILP (tem)) return elt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1309 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1310 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1311 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1312 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1313
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1314 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1315 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1316 The value is actually the element of LIST whose cdr is ELT.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1317 (key, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1318 register Lisp_Object key;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1319 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1320 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1321 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1322 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1323 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324 register Lisp_Object elt, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1325 elt = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1326 if (!CONSP (elt)) continue;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1327 tem = XCONS (elt)->cdr;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1328 if (EQ (key, tem)) return elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1329 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1330 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1331 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1332 }
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1333
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1334 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1335 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1336 The value is actually the element of LIST whose cdr equals KEY.")
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1337 (key, list)
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1338 register Lisp_Object key;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1339 Lisp_Object list;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1340 {
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1341 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1342 for (tail = list; !NILP (tail); tail = XCONS (tail)->cdr)
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1343 {
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1344 register Lisp_Object elt, tem;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1345 elt = Fcar (tail);
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1346 if (!CONSP (elt)) continue;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1347 tem = Fequal (XCONS (elt)->cdr, key);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1348 if (!NILP (tem)) return elt;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1349 QUIT;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1350 }
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1351 return Qnil;
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
1352 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1353
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1354 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1355 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1356 The modified LIST is returned. Comparison is done with `eq'.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1357 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358 therefore, write `(setq foo (delq element foo))'\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1359 to be sure of changing the value of `foo'.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1360 (elt, list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1361 register Lisp_Object elt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1362 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1363 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1364 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1365 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1366
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1367 tail = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1368 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1369 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1370 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1371 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1372 if (EQ (elt, tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1373 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1374 if (NILP (prev))
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1375 list = XCONS (tail)->cdr;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1376 else
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1377 Fsetcdr (prev, XCONS (tail)->cdr);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1378 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1379 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1380 prev = tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1381 tail = XCONS (tail)->cdr;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1382 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1383 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1384 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1385 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1386
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
1387 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1388 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1389 The modified LIST is returned. Comparison is done with `equal'.\n\
6990
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1390 If the first member of LIST is ELT, deleting it is not a side effect;\n\
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1391 it is simply using a different list.\n\
9bfef236ac9a Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 6850
diff changeset
1392 Therefore, write `(setq foo (delete element foo))'\n\
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1393 to be sure of changing the value of `foo'.")
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1394 (elt, list)
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1395 register Lisp_Object elt;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1396 Lisp_Object list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1397 {
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1398 register Lisp_Object tail, prev;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1399 register Lisp_Object tem;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1400
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1401 tail = list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1402 prev = Qnil;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1403 while (!NILP (tail))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1404 {
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1405 tem = Fcar (tail);
1513
7381accd610d * fns.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents: 1194
diff changeset
1406 if (! NILP (Fequal (elt, tem)))
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1407 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1408 if (NILP (prev))
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1409 list = XCONS (tail)->cdr;
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1410 else
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1411 Fsetcdr (prev, XCONS (tail)->cdr);
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1412 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1413 else
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1414 prev = tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1415 tail = XCONS (tail)->cdr;
401
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1416 QUIT;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1417 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1418 return list;
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1419 }
24b63d6679b6 *** empty log message ***
Roland McGrath <roland@gnu.org>
parents: 399
diff changeset
1420
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422 "Reverse LIST by modifying cdr pointers.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1423 Returns the beginning of the reversed list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1424 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1425 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1426 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1427 register Lisp_Object prev, tail, next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1428
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1429 if (NILP (list)) return list;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430 prev = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1431 tail = list;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1432 while (!NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1433 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1434 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1435 next = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1436 Fsetcdr (tail, prev);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1437 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1438 tail = next;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1439 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1440 return prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1441 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1442
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1443 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1444 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1445 See also the function `nreverse', which is used more often.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1446 (list)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1447 Lisp_Object list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1448 {
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1449 Lisp_Object new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1450
18421
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1451 for (new = Qnil; CONSP (list); list = XCONS (list)->cdr)
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1452 new = Fcons (XCONS (list)->car, new);
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1453 if (!NILP (list))
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1454 wrong_type_argument (Qconsp, list);
618cc7b75c06 (Freverse): Simplify.
Richard M. Stallman <rms@gnu.org>
parents: 18311
diff changeset
1455 return new;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1456 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1457
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1458 Lisp_Object merge ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1459
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1460 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1461 "Sort LIST, stably, comparing elements using PREDICATE.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1462 Returns the sorted list. LIST is modified by side effects.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1463 PREDICATE is called with two elements of LIST, and should return T\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1464 if the first element is \"less\" than the second.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1465 (list, predicate)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1466 Lisp_Object list, predicate;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1468 Lisp_Object front, back;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1469 register Lisp_Object len, tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1470 struct gcpro gcpro1, gcpro2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1471 register int length;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1472
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1473 front = list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1474 len = Flength (list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1475 length = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1476 if (length < 2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1477 return list;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1478
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1479 XSETINT (len, (length / 2) - 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1480 tem = Fnthcdr (len, list);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1481 back = Fcdr (tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1482 Fsetcdr (tem, Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1483
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1484 GCPRO2 (front, back);
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1485 front = Fsort (front, predicate);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1486 back = Fsort (back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1487 UNGCPRO;
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1488 return merge (front, back, predicate);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1489 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1490
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1491 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1492 merge (org_l1, org_l2, pred)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1493 Lisp_Object org_l1, org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1494 Lisp_Object pred;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1495 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1496 Lisp_Object value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1497 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1498 Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1499 register Lisp_Object l1, l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1500 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1501
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1502 l1 = org_l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1503 l2 = org_l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1504 tail = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1505 value = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1506
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1507 /* It is sufficient to protect org_l1 and org_l2.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1508 When l1 and l2 are updated, we copy the new values
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1509 back into the org_ vars. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1510 GCPRO4 (org_l1, org_l2, pred, value);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1511
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1512 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1513 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1514 if (NILP (l1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1515 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1516 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1517 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1518 return l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1519 Fsetcdr (tail, l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1520 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1521 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1522 if (NILP (l2))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1523 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1524 UNGCPRO;
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1525 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1526 return l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1527 Fsetcdr (tail, l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1528 return value;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1529 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1530 tem = call2 (pred, Fcar (l2), Fcar (l1));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1531 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1532 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1533 tem = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1534 l1 = Fcdr (l1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1535 org_l1 = l1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1536 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1537 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1538 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1539 tem = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1540 l2 = Fcdr (l2);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1541 org_l2 = l2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1542 }
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1543 if (NILP (tail))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1544 value = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1545 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1546 Fsetcdr (tail, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1547 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1548 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1550
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1551
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1552 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
1553 "Extract a value from a property list.\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1554 PLIST is a property list, which is a list of the form\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1555 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1556 corresponding to the given PROP, or nil if PROP is not\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1557 one of the properties on the list.")
14051
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
1558 (plist, prop)
7f7e97f219ce (Fplist_get): Rename arg `val' to `plist' as in doc.
Erik Naggum <erik@naggum.no>
parents: 13862
diff changeset
1559 Lisp_Object plist;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1560 register Lisp_Object prop;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1561 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1562 register Lisp_Object tail;
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1563 for (tail = plist; !NILP (tail); tail = Fcdr (XCONS (tail)->cdr))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1564 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1565 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1566 tem = Fcar (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1567 if (EQ (prop, tem))
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
1568 return Fcar (XCONS (tail)->cdr);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1569 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1570 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1571 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1572
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1573 DEFUN ("get", Fget, Sget, 2, 2, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1574 "Return the value of SYMBOL's PROPNAME property.\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1575 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1576 (symbol, propname)
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1577 Lisp_Object symbol, propname;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1578 {
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1579 CHECK_SYMBOL (symbol, 0);
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1580 return Fplist_get (XSYMBOL (symbol)->plist, propname);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1581 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1582
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1583 DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1584 "Change value in PLIST of PROP to VAL.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1585 PLIST is a property list, which is a list of the form\n\
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1586 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1587 If PROP is already a property on the list, its value is set to VAL,\n\
11221
254a5316fc98 (Fplist_put): Fix missing \n\.
Karl Heuer <kwzh@gnu.org>
parents: 11194
diff changeset
1588 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1589 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1590 The PLIST is modified by side effects.")
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1591 (plist, prop, val)
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1592 Lisp_Object plist;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1593 register Lisp_Object prop;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1594 Lisp_Object val;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1595 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1596 register Lisp_Object tail, prev;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1597 Lisp_Object newcell;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1598 prev = Qnil;
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1599 for (tail = plist; CONSP (tail) && CONSP (XCONS (tail)->cdr);
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1600 tail = XCONS (XCONS (tail)->cdr)->cdr)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1601 {
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1602 if (EQ (prop, XCONS (tail)->car))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1603 {
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1604 Fsetcar (XCONS (tail)->cdr, val);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1605 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1606 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1607 prev = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1608 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1609 newcell = Fcons (prop, Fcons (val, Qnil));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
1610 if (NILP (prev))
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1611 return newcell;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1612 else
11539
d8227796a997 (Fplist_put): Don't signal an error if plist isn't a cons.
Karl Heuer <kwzh@gnu.org>
parents: 11240
diff changeset
1613 Fsetcdr (XCONS (prev)->cdr, newcell);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1614 return plist;
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1615 }
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1616
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1617 DEFUN ("put", Fput, Sput, 3, 3, 0,
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1618 "Store SYMBOL's PROPNAME property with value VALUE.\n\
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1619 It can be retrieved with `(get SYMBOL PROPNAME)'.")
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1620 (symbol, propname, value)
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1621 Lisp_Object symbol, propname, value;
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
1622 {
11138
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1623 CHECK_SYMBOL (symbol, 0);
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1624 XSYMBOL (symbol)->plist
8eed13a00d2b (Fget, Fput): Fetch and store symbol's plist directly.
Richard M. Stallman <rms@gnu.org>
parents: 11130
diff changeset
1625 = 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
1626 return value;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1627 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1628
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1629 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1630 "Return t if two Lisp objects have similar structure and contents.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1631 They must have the same data type.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1632 Conses are compared by comparing the cars and the cdrs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1633 Vectors and strings are compared element by element.\n\
3379
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
1634 Numbers are compared by value, but integers cannot equal floats.\n\
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
1635 (Use `=' if you want integers and floats to be able to be equal.)\n\
68f28e378f50 (internal_equal): Don't let ints be equal to floats.
Richard M. Stallman <rms@gnu.org>
parents: 3332
diff changeset
1636 Symbols must match exactly.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1637 (o1, o2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1638 register Lisp_Object o1, o2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1639 {
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1640 return internal_equal (o1, o2, 0) ? Qt : Qnil;
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1641 }
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1642
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1643 static int
399
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1644 internal_equal (o1, o2, depth)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1645 register Lisp_Object o1, o2;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1646 int depth;
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1647 {
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1648 if (depth > 200)
21aa17a1560d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 350
diff changeset
1649 error ("Stack overflow in equal");
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1650
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1651 tail_recurse:
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1652 QUIT;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1653 if (EQ (o1, o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1654 return 1;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1655 if (XTYPE (o1) != XTYPE (o2))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1656 return 0;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1657
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1658 switch (XTYPE (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1659 {
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1660 #ifdef LISP_FLOAT_TYPE
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1661 case Lisp_Float:
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1662 return (extract_float (o1) == extract_float (o2));
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1663 #endif
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1664
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1665 case Lisp_Cons:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1666 if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1))
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1667 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1668 o1 = XCONS (o1)->cdr;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1669 o2 = XCONS (o2)->cdr;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1670 goto tail_recurse;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1671
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1672 case Lisp_Misc:
11240
2642924d2d21 (internal_equal): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
1673 if (XMISCTYPE (o1) != XMISCTYPE (o2))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1674 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1675 if (OVERLAYP (o1))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1676 {
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1677 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1),
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1678 depth + 1)
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1679 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o1),
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1680 depth + 1))
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1681 return 0;
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1682 o1 = XOVERLAY (o1)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1683 o2 = XOVERLAY (o2)->plist;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1684 goto tail_recurse;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1685 }
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1686 if (MARKERP (o1))
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1687 {
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1688 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
1689 && (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
1690 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1691 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1692 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1693
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1694 case Lisp_Vectorlike:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1695 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1696 register int i, size;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1697 size = XVECTOR (o1)->size;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1698 /* 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
1699 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
1700 same size. */
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1701 if (XVECTOR (o2)->size != size)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1702 return 0;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1703 /* Boolvectors are compared much like strings. */
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1704 if (BOOL_VECTOR_P (o1))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1705 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1706 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
1707 = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1708
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1709 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
1710 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1711 if (bcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1712 size_in_chars))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1713 return 0;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1714 return 1;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1715 }
20776
219fdecc30d3 (internal_equal): Use compare_window_configurations.
Richard M. Stallman <rms@gnu.org>
parents: 20712
diff changeset
1716 if (WINDOW_CONFIGURATIONP (o1))
21021
7be2384fabdc (internal_equal): compare_window_configurations takes new arg.
Richard M. Stallman <rms@gnu.org>
parents: 20992
diff changeset
1717 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
1718
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1719 /* Aside from them, only true vectors, char-tables, and compiled
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1720 functions are sensible to compare, so eliminate the others now. */
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1721 if (size & PSEUDOVECTOR_FLAG)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1722 {
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1723 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1724 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1725 size &= PSEUDOVECTOR_SIZE_MASK;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1726 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1727 for (i = 0; i < size; i++)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1728 {
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1729 Lisp_Object v1, v2;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1730 v1 = XVECTOR (o1)->contents [i];
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1731 v2 = XVECTOR (o2)->contents [i];
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1732 if (!internal_equal (v1, v2, depth + 1))
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1733 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1734 }
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1735 return 1;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1736 }
10405
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1737 break;
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1738
609f34c0c7bc (internal_equal): Once again use a switch.
Richard M. Stallman <rms@gnu.org>
parents: 10289
diff changeset
1739 case Lisp_String:
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1740 if (XSTRING (o1)->size != XSTRING (o2)->size)
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1741 return 0;
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1742 if (STRING_BYTES (XSTRING (o1)) != STRING_BYTES (XSTRING (o2)))
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1743 return 0;
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1744 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data,
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
1745 STRING_BYTES (XSTRING (o1))))
10411
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1746 return 0;
b3c03881e6f6 (internal_equal): Delete redundant tests.
Karl Heuer <kwzh@gnu.org>
parents: 10405
diff changeset
1747 return 1;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1748 }
9927
05aa745fc829 (internal_equal): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9439
diff changeset
1749 return 0;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1750 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1751
18613
614b916ff5bf Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents: 18531
diff changeset
1752 extern Lisp_Object Fmake_char_internal ();
614b916ff5bf Fix bugs with inappropriate mixing of Lisp_Object with int.
Richard M. Stallman <rms@gnu.org>
parents: 18531
diff changeset
1753
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1754 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1755 "Store each element of ARRAY with ITEM.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1756 ARRAY is a vector, string, char-table, or bool-vector.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1757 (array, item)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1758 Lisp_Object array, item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1759 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1760 register int size, index, charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1761 retry:
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1762 if (VECTORP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1763 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764 register Lisp_Object *p = XVECTOR (array)->contents;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 size = XVECTOR (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1766 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767 p[index] = item;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1768 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1769 else if (CHAR_TABLE_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1770 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1771 register Lisp_Object *p = XCHAR_TABLE (array)->contents;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1772 size = CHAR_TABLE_ORDINARY_SLOTS;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1773 for (index = 0; index < size; index++)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1774 p[index] = item;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1775 XCHAR_TABLE (array)->defalt = Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1776 }
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
1777 else if (STRINGP (array))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1778 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1779 register unsigned char *p = XSTRING (array)->data;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1780 CHECK_NUMBER (item, 1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1781 charval = XINT (item);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1782 size = XSTRING (array)->size;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1783 for (index = 0; index < size; index++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1784 p[index] = charval;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1785 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1786 else if (BOOL_VECTOR_P (array))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1787 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1788 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
1789 int size_in_chars
17063
647b28ba4d1b (Fcopy_sequence, concat, internal_equal, Ffillarray):
Karl Heuer <kwzh@gnu.org>
parents: 16863
diff changeset
1790 = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1791
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1792 charval = (! NILP (item) ? -1 : 0);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1793 for (index = 0; index < size_in_chars; index++)
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1794 p[index] = charval;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1795 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796 else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1797 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1798 array = wrong_type_argument (Qarrayp, array);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1799 goto retry;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1800 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1801 return array;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1802 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1803
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1804 DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1805 1, 1, 0,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1806 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1807 (char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1808 Lisp_Object char_table;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1809 {
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1810 CHECK_CHAR_TABLE (char_table, 0);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1811
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1812 return XCHAR_TABLE (char_table)->purpose;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1813 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1814
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1815 DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1816 1, 1, 0,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1817 "Return the parent char-table of CHAR-TABLE.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1818 The value is either nil or another char-table.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1819 If CHAR-TABLE holds nil for a given character,\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1820 then the actual applicable value is inherited from the parent char-table\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1821 \(or from its parents, if necessary).")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1822 (char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1823 Lisp_Object char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1824 {
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1825 CHECK_CHAR_TABLE (char_table, 0);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1826
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1827 return XCHAR_TABLE (char_table)->parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1828 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1829
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1830 DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1831 2, 2, 0,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1832 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1833 PARENT must be either nil or another char-table.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1834 (char_table, parent)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1835 Lisp_Object char_table, parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1836 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1837 Lisp_Object temp;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1838
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1839 CHECK_CHAR_TABLE (char_table, 0);
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1840
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1841 if (!NILP (parent))
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1842 {
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1843 CHECK_CHAR_TABLE (parent, 0);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1844
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1845 for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
14097
91c55574973f (Fset_char_table_parent): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 14091
diff changeset
1846 if (EQ (temp, char_table))
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1847 error ("Attempt to make a chartable be its own parent");
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
1848 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1849
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1850 XCHAR_TABLE (char_table)->parent = parent;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1851
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1852 return parent;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1853 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1854
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1855 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1856 2, 2, 0,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
1857 "Return the value of CHAR-TABLE's extra-slot number N.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1858 (char_table, n)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1859 Lisp_Object char_table, n;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1860 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1861 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1862 CHECK_NUMBER (n, 2);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1863 if (XINT (n) < 0
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1864 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1865 args_out_of_range (char_table, n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1866
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1867 return XCHAR_TABLE (char_table)->extras[XINT (n)];
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1868 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1869
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1870 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1871 Sset_char_table_extra_slot,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1872 3, 3, 0,
17291
b66473f0d0fe (Fcopy_sequence): Delete unused variable.
Karl Heuer <kwzh@gnu.org>
parents: 17182
diff changeset
1873 "Set CHAR-TABLE's extra-slot number N to VALUE.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1874 (char_table, n, value)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1875 Lisp_Object char_table, n, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1876 {
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1877 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1878 CHECK_NUMBER (n, 2);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1879 if (XINT (n) < 0
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1880 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1881 args_out_of_range (char_table, n);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1882
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1883 return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1884 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
1885
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1886 DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1887 2, 2, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1888 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1889 RANGE should be nil (for the default value)\n\
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1890 a vector which identifies a character set or a row of a character set,\n\
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1891 a character set name, or a character code.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1892 (char_table, range)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1893 Lisp_Object char_table, range;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1894 {
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1895 int i;
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1896
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1897 CHECK_CHAR_TABLE (char_table, 0);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1898
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1899 if (EQ (range, Qnil))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1900 return XCHAR_TABLE (char_table)->defalt;
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1901 else if (INTEGERP (range))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1902 return Faref (char_table, range);
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1903 else if (SYMBOLP (range))
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1904 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1905 Lisp_Object charset_info;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1906
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1907 charset_info = Fget (range, Qcharset);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1908 CHECK_VECTOR (charset_info, 0);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1909
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1910 return Faref (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1911 make_number (XINT (XVECTOR (charset_info)->contents[0])
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1912 + 128));
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1913 }
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1914 else if (VECTORP (range))
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1915 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1916 if (XVECTOR (range)->size == 1)
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1917 return Faref (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1918 make_number (XINT (XVECTOR (range)->contents[0]) + 128));
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1919 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1920 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1921 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1922 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1923 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1924 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1925 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1926 return Faref (char_table, ch);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1927 }
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1928 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1929 else
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1930 error ("Invalid RANGE argument to `char-table-range'");
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1931 }
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
1932
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1933 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1934 3, 3, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1935 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1936 RANGE should be t (for all characters), nil (for the default value)\n\
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1937 a vector which identifies a character set or a row of a character set,\n\
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1938 a coding system, or a character code.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1939 (char_table, range, value)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1940 Lisp_Object char_table, range, value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1941 {
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1942 int i;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1943
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1944 CHECK_CHAR_TABLE (char_table, 0);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
1945
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1946 if (EQ (range, Qt))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1947 for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1948 XCHAR_TABLE (char_table)->contents[i] = value;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1949 else if (EQ (range, Qnil))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1950 XCHAR_TABLE (char_table)->defalt = value;
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1951 else if (SYMBOLP (range))
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1952 {
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1953 Lisp_Object charset_info;
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1954
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1955 charset_info = Fget (range, Qcharset);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1956 CHECK_VECTOR (charset_info, 0);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1957
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1958 return Faset (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1959 make_number (XINT (XVECTOR (charset_info)->contents[0])
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1960 + 128),
20813
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1961 value);
b040da7cfab8 (concat): If making a string, a nonempty bool-vector is error.
Richard M. Stallman <rms@gnu.org>
parents: 20776
diff changeset
1962 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1963 else if (INTEGERP (range))
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
1964 Faset (char_table, range, value);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1965 else if (VECTORP (range))
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1966 {
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1967 if (XVECTOR (range)->size == 1)
21523
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1968 return Faset (char_table,
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1969 make_number (XINT (XVECTOR (range)->contents[0]) + 128),
33d800bf97c3 (Fsubstring, substring_both, Fchar_table_range,
Andreas Schwab <schwab@suse.de>
parents: 21514
diff changeset
1970 value);
18035
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1971 else
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1972 {
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1973 int size = XVECTOR (range)->size;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1974 Lisp_Object *val = XVECTOR (range)->contents;
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1975 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1976 size <= 1 ? Qnil : val[1],
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1977 size <= 2 ? Qnil : val[2]);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1978 return Faset (char_table, ch, value);
edf54f605b36 (Fchar_table_range, Fset_char_table_range):
Richard M. Stallman <rms@gnu.org>
parents: 18000
diff changeset
1979 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1980 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1981 else
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1982 error ("Invalid RANGE argument to `set-char-table-range'");
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1983
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1984 return value;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
1985 }
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1986
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1987 DEFUN ("set-char-table-default", Fset_char_table_default,
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1988 Sset_char_table_default, 3, 3, 0,
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1989 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1990 The generic character specifies the group of characters.\n\
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1991 See also the documentation of make-char.")
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1992 (char_table, ch, value)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1993 Lisp_Object char_table, ch, value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1994 {
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1995 int c, i, charset, code1, code2;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1996 Lisp_Object temp;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1997
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1998 CHECK_CHAR_TABLE (char_table, 0);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
1999 CHECK_NUMBER (ch, 1);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2000
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2001 c = XINT (ch);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2002 SPLIT_NON_ASCII_CHAR (c, charset, code1, code2);
22701
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2003
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2004 /* Since we may want to set the default value for a character set
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2005 not yet defined, we check only if the character set is in the
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2006 valid range or not, instead of it is already defined or not. */
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2007 if (! CHARSET_VALID_P (charset))
22706
27a8a6847be2 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 22701
diff changeset
2008 invalid_character (c);
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2009
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2010 if (charset == CHARSET_ASCII)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2011 return (XCHAR_TABLE (char_table)->defalt = value);
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2012
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2013 /* Even if C is not a generic char, we had better behave as if a
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2014 generic char is specified. */
22701
c771a25f6f8c (Fset_char_table_default): Check only if the charset of
Kenichi Handa <handa@m17n.org>
parents: 22696
diff changeset
2015 if (charset == CHARSET_COMPOSITION || CHARSET_DIMENSION (charset) == 1)
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2016 code1 = 0;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2017 temp = XCHAR_TABLE (char_table)->contents[charset + 128];
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2018 if (!code1)
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2019 {
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2020 if (SUB_CHAR_TABLE_P (temp))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2021 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2022 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2023 XCHAR_TABLE (char_table)->contents[charset + 128] = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2024 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2025 }
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2026 char_table = temp;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2027 if (! SUB_CHAR_TABLE_P (char_table))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2028 char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2029 = make_sub_char_table (temp));
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2030 temp = XCHAR_TABLE (char_table)->contents[code1];
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2031 if (SUB_CHAR_TABLE_P (temp))
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2032 XCHAR_TABLE (temp)->defalt = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2033 else
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2034 XCHAR_TABLE (char_table)->contents[code1] = value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2035 return value;
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2036 }
21339
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2037
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2038 /* Look up the element in TABLE at index CH,
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2039 and return it as an integer.
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2040 If the element is nil, return CH itself.
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2041 (Actually we do that for any non-integer.) */
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2042
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2043 int
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2044 char_table_translate (table, ch)
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2045 Lisp_Object table;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2046 int ch;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2047 {
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2048 Lisp_Object value;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2049 value = Faref (table, make_number (ch));
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2050 if (! INTEGERP (value))
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2051 return ch;
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2052 return XINT (value);
91933098b4ae (char_table_translate): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21260
diff changeset
2053 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2054
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2055 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2056 character or group of characters that share a value.
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2057 DEPTH is the current depth in the originally specified
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2058 chartable, and INDICES contains the vector indices
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2059 for the levels our callers have descended.
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2060
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2061 ARG is passed to C_FUNCTION when that is called. */
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2062
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2063 void
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2064 map_char_table (c_function, function, subtable, arg, depth, indices)
20314
3fb425cf6a83 * fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents: 20148
diff changeset
2065 void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
3fb425cf6a83 * fns.c (map_char_table): Protoize parameter.
Andreas Schwab <schwab@suse.de>
parents: 20148
diff changeset
2066 Lisp_Object function, subtable, arg, *indices;
16105
1712db4a1709 (map_char_table): Declare depth as int.
Richard M. Stallman <rms@gnu.org>
parents: 15966
diff changeset
2067 int depth;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2068 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2069 int i, to;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2070
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2071 if (depth == 0)
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2072 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2073 /* At first, handle ASCII and 8-bit European characters. */
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2074 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2075 {
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2076 Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2077 if (c_function)
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2078 (*c_function) (arg, make_number (i), elt);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2079 else
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2080 call2 (function, make_number (i), elt);
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2081 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2082 #if 0 /* If the char table has entries for higher characters,
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2083 we should report them. */
20148
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2084 if (NILP (current_buffer->enable_multibyte_characters))
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2085 return;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2086 #endif
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2087 to = CHAR_TABLE_ORDINARY_SLOTS;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2088 }
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2089 else
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2090 {
20148
988eef7dba1b (map_char_table): Do not operate on invalid characters.
Kenichi Handa <handa@m17n.org>
parents: 20004
diff changeset
2091 i = 32;
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2092 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2093 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2094
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2095 for (; i < to; i++)
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2096 {
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2097 Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2098
18108
af791b0f0657 (map_char_table): Use XSETFASTINT.
Richard M. Stallman <rms@gnu.org>
parents: 18035
diff changeset
2099 XSETFASTINT (indices[depth], i);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2100
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2101 if (SUB_CHAR_TABLE_P (elt))
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2102 {
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2103 if (depth >= 3)
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2104 error ("Too deep char table");
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2105 map_char_table (c_function, function, elt, arg, depth + 1, indices);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2106 }
13184
04170e19b3d4 (Fcopy_sequence): Call Fmake_char_table the new way.
Richard M. Stallman <rms@gnu.org>
parents: 13140
diff changeset
2107 else
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2108 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2109 int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2110
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2111 if (CHARSET_DEFINED_P (charset))
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2112 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2113 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2114 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2115 c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2116 if (c_function)
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2117 (*c_function) (arg, make_number (c), elt);
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2118 else
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2119 call2 (function, make_number (c), elt);
17182
47bfc66eb7f1 (map_char_table): Handle multibyte characters.
Kenichi Handa <handa@m17n.org>
parents: 17063
diff changeset
2120 }
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2121 }
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2122 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2123 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2124
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2125 DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2126 2, 2, 0,
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2127 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2128 FUNCTION is called with two arguments--a key and a value.\n\
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2129 The key is always a possible IDX argument to `aref'.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2130 (function, char_table)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2131 Lisp_Object function, char_table;
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2132 {
17318
224e100b393c (copy_sub_char_table): New function.
Kenichi Handa <handa@m17n.org>
parents: 17291
diff changeset
2133 /* The depth of char table is at most 3. */
18000
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2134 Lisp_Object indices[3];
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2135
2873e0dabbc1 (map_char_table): For sub char-table, index should be
Kenichi Handa <handa@m17n.org>
parents: 17931
diff changeset
2136 CHECK_CHAR_TABLE (char_table, 1);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2137
17789
120a8d934816 (map_char_table): New arg SUBTABLE. Callers changed.
Richard M. Stallman <rms@gnu.org>
parents: 17318
diff changeset
2138 map_char_table (NULL, function, char_table, char_table, 0, indices);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2139 return Qnil;
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2140 }
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2141
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2142 /* ARGSUSED */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2143 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2144 nconc2 (s1, s2)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2145 Lisp_Object s1, s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2146 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2147 #ifdef NO_ARG_ARRAY
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2148 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2149 args[0] = s1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2150 args[1] = s2;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2151 return Fnconc (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2152 #else
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2153 return Fnconc (2, &s1);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2154 #endif /* NO_ARG_ARRAY */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2155 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2156
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2157 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2158 "Concatenate any number of lists by altering them.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2159 Only the last argument is not altered, and need not be a list.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2160 (nargs, args)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2161 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2162 Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2163 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2164 register int argnum;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2165 register Lisp_Object tail, tem, val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2166
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2167 val = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2168
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2169 for (argnum = 0; argnum < nargs; argnum++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2170 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2171 tem = args[argnum];
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2172 if (NILP (tem)) continue;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2173
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2174 if (NILP (val))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2175 val = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2176
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2177 if (argnum + 1 == nargs) break;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2178
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2179 if (!CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2180 tem = wrong_type_argument (Qlistp, tem);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2181
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2182 while (CONSP (tem))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2183 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2184 tail = tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2185 tem = Fcdr (tail);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2186 QUIT;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2187 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2188
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2189 tem = args[argnum + 1];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2190 Fsetcdr (tail, tem);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2191 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2192 args[argnum + 1] = tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2193 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2194
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2195 return val;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2196 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2197
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2198 /* 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
2199 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
2200 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
2201 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
2202
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2203 static void
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2204 mapcar1 (leni, vals, fn, seq)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2205 int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2206 Lisp_Object *vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2207 Lisp_Object fn, seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2208 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2209 register Lisp_Object tail;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2210 Lisp_Object dummy;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2211 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2212 struct gcpro gcpro1, gcpro2, gcpro3;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2213
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2214 /* Don't let vals contain any garbage when GC happens. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2215 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2216 vals[i] = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2217
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2218 GCPRO3 (dummy, fn, seq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2219 gcpro1.var = vals;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2220 gcpro1.nvars = leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2221 /* We need not explicitly protect `tail' because it is used only on lists, and
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2222 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2223
9128
04a702d7f662 (Frandom, Flength, Fstring_equal, Fstring_lessp, Fcopy_sequence, concat, Felt,
Karl Heuer <kwzh@gnu.org>
parents: 8966
diff changeset
2224 if (VECTORP (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2225 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2226 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2227 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2228 dummy = XVECTOR (seq)->contents[i];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2229 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2230 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2231 }
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2232 else if (BOOL_VECTOR_P (seq))
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2233 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2234 for (i = 0; i < leni; i++)
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2235 {
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2236 int byte;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2237 byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR];
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2238 if (byte & (1 << (i % BITS_PER_CHAR)))
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2239 dummy = Qt;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2240 else
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2241 dummy = Qnil;
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2242
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2243 vals[i] = call1 (fn, dummy);
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2244 }
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2245 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2246 else if (STRINGP (seq) && ! STRING_MULTIBYTE (seq))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2247 {
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2248 /* Single-byte string. */
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2249 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2250 {
9308
2c594629baaa (Flength, concat, mapcar1): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents: 9289
diff changeset
2251 XSETFASTINT (dummy, XSTRING (seq)->data[i]);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2252 vals[i] = call1 (fn, dummy);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2253 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2254 }
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2255 else if (STRINGP (seq))
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2256 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2257 /* Multi-byte string. */
21244
50929073a0ba Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents: 21218
diff changeset
2258 int len_byte = STRING_BYTES (XSTRING (seq));
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2259 int i_byte;
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2260
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2261 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
2262 {
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2263 int c;
20712
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2264 int i_before = i;
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2265
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2266 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
2267 XSETFASTINT (dummy, c);
20712
50255c536f0f (mapcar1): Keep `i' in `i_before' before `i' is
Kenichi Handa <handa@m17n.org>
parents: 20706
diff changeset
2268 vals[i_before] = call1 (fn, dummy);
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2269 }
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2270 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2271 else /* Must be a list, since Flength did not get an error */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2272 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2273 tail = seq;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2274 for (i = 0; i < leni; i++)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2275 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2276 vals[i] = call1 (fn, Fcar (tail));
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
2277 tail = XCONS (tail)->cdr;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2278 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2279 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2280
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2281 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2282 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2283
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2284 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2285 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2286 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2287 SEPARATOR results in spaces between the values returned by FUNCTION.\n\
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2288 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2289 (function, sequence, separator)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2290 Lisp_Object function, sequence, separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2291 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2292 Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2293 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2294 int nargs;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2295 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2296 register int i;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2297 struct gcpro gcpro1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2298
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2299 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2300 leni = XINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2301 nargs = leni + leni - 1;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2302 if (nargs < 0) return build_string ("");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2303
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2304 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2305
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2306 GCPRO1 (separator);
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2307 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2308 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2309
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2310 for (i = leni - 1; i >= 0; i--)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2311 args[i + i] = args[i];
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2312
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2313 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
2314 args[i] = separator;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2315
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2316 return Fconcat (nargs, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2317 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2318
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2319 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2320 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2321 The result is a list just as long as SEQUENCE.\n\
20992
d2366423bc00 (mapcar1): Handle bool-vectors.
Karl Heuer <kwzh@gnu.org>
parents: 20928
diff changeset
2322 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2323 (function, sequence)
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2324 Lisp_Object function, sequence;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2325 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2326 register Lisp_Object len;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2327 register int leni;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2328 register Lisp_Object *args;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2329
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2330 len = Flength (sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2331 leni = XFASTINT (len);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2332 args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2333
14091
34911b128a47 (Frandom, Flength, Felt, Fsort, Fchar_table_subtype, Fchar_table_parent,
Erik Naggum <erik@naggum.no>
parents: 14051
diff changeset
2334 mapcar1 (leni, args, function, sequence);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2335
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2336 return Flist (leni, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2337 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2338
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2339 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2340
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2341 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2342 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
759
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2343 Takes one argument, which is the string to display to ask the question.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2344 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2345 No confirmation of the answer is requested; a single character is enough.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2346 Also accepts Space to mean yes, or Delete to mean no.")
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2347 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2348 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2349 {
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2350 register Lisp_Object obj, key, def, answer_string, map;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2351 register int answer;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2352 Lisp_Object xprompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 struct gcpro gcpro1, gcpro2;
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2355 int count = specpdl_ptr - specpdl;
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2356
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2357 specbind (Qcursor_in_echo_area, Qt);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2358
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2359 map = Fsymbol_value (intern ("query-replace-map"));
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2360
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2361 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2362 xprompt = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2363 GCPRO2 (prompt, xprompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2364
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2365 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2366 {
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2367
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
2368 #ifdef HAVE_MENUS
7790
75153e2d5d85 (Fy_or_n_p): Don't use dialog box if not an X frame.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
2369 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
2370 && 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
2371 && 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
2372 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2373 Lisp_Object pane, menu;
7815
5d167db8ce8a (Fy_or_n_p, Fyes_or_no_p) [HAVE_X_MENU]: Redisplay before popping up a menu.
Karl Heuer <kwzh@gnu.org>
parents: 7790
diff changeset
2374 redisplay_preserve_echo_area ();
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2375 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
2376 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
2377 Qnil));
6478
65c2e184b5d9 (Fy_or_n_p, Fyes_or_no_p): Call Fx_popup_dialog the new way.
Richard M. Stallman <rms@gnu.org>
parents: 6427
diff changeset
2378 menu = Fcons (prompt, pane);
6303
1571be153f56 (Fyes_or_no_p): Call Fx_popup_dialog instead of Fx_popup_menu.
Fred Pierresteguy <F.Pierresteguy@frcl.bull.fr>
parents: 6057
diff changeset
2379 obj = Fx_popup_dialog (Qt, menu);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2380 answer = !NILP (obj);
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2381 break;
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2382 }
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
2383 #endif /* HAVE_MENUS */
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
2384 cursor_in_echo_area = 1;
14392
127c6142a07a (Fy_or_n_p): Call choose_minibuf_frame.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
2385 choose_minibuf_frame ();
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2386 message_with_string ("%s(y or n) ", xprompt, 0);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2387
16561
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2388 if (minibuffer_auto_raise)
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2389 {
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2390 Lisp_Object mini_frame;
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2391
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2392 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2393
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2394 Fraise_frame (mini_frame);
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2395 }
55fcbbf28987 Include frame.h and window.h.
Richard M. Stallman <rms@gnu.org>
parents: 16105
diff changeset
2396
23057
2dbf1ec20bf7 (Fy_or_n_p): Don't bind input-method-function.
Richard M. Stallman <rms@gnu.org>
parents: 23051
diff changeset
2397 obj = read_filtered_event (1, 0, 0, 0);
6850
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
2398 cursor_in_echo_area = 0;
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
2399 /* If we need to quit, quit with cursor_in_echo_area = 0. */
d2d8b40fb599 (Fy_or_n_p, Fyes_or_no_p): Test HAVE_X_MENU.
Karl Heuer <kwzh@gnu.org>
parents: 6478
diff changeset
2400 QUIT;
2369
8ce8541f393a (Fy_or_n_p): Ensure cursor_in_echo_area = 0 when quit.
Richard M. Stallman <rms@gnu.org>
parents: 2311
diff changeset
2401
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2402 key = Fmake_vector (make_number (1), obj);
15713
27487191083d (Fy_or_n_p): Pass 3rd arg to Flookup_key.
Karl Heuer <kwzh@gnu.org>
parents: 14617
diff changeset
2403 def = Flookup_key (map, key, Qt);
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2404 answer_string = Fsingle_key_description (obj);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2405
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2406 if (EQ (def, intern ("skip")))
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2407 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2408 answer = 0;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2409 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2410 }
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2411 else if (EQ (def, intern ("act")))
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2412 {
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2413 answer = 1;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2414 break;
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2415 }
2311
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2416 else if (EQ (def, intern ("recenter")))
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2417 {
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2418 Frecenter (Qnil);
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2419 xprompt = prompt;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2420 continue;
98b714786ad0 (Fy_or_n_p): Handle `recenter' response type.
Richard M. Stallman <rms@gnu.org>
parents: 2171
diff changeset
2421 }
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2422 else if (EQ (def, intern ("quit")))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2423 Vquit_flag = Qt;
10059
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
2424 /* We want to exit this command for exit-prefix,
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
2425 and this is the only way to do it. */
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
2426 else if (EQ (def, intern ("exit-prefix")))
c1b138be512e (Fy_or_n_p): Handle exit-prefix in query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 10006
diff changeset
2427 Vquit_flag = Qt;
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2428
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2429 QUIT;
1194
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
2430
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
2431 /* If we don't clear this, then the next call to read_char will
e0a970069f9e Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1193
diff changeset
2432 return quit_char again, and we'll enter an infinite loop. */
1193
e1329d41271d * fns.c (Fy_or_n_p): After testing for a QUIT, clear Vquit_flag.
Jim Blandy <jimb@redhat.com>
parents: 1093
diff changeset
2433 Vquit_flag = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2434
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2435 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2436 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2437 if (EQ (xprompt, prompt))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2438 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2439 args[0] = build_string ("Please answer y or n. ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2440 args[1] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2441 xprompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2442 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2443 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2444 UNGCPRO;
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
2445
2525
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
2446 if (! noninteractive)
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
2447 {
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
2448 cursor_in_echo_area = -1;
20607
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2449 message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n",
04a436e5760b (map_char_table): Unconditionally consider non-ASCII charsets.
Richard M. Stallman <rms@gnu.org>
parents: 20567
diff changeset
2450 xprompt, 0);
2525
6cf2344e6e7e (Fy_or_n_p): Echo the answer just once, at exit.
Richard M. Stallman <rms@gnu.org>
parents: 2429
diff changeset
2451 }
2171
4fbceca13b22 * fns.c (Fy_or_n_p): Display the answer.
Jim Blandy <jimb@redhat.com>
parents: 2091
diff changeset
2452
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2453 unbind_to (count, Qnil);
2091
eedbad26e34c (Fy_or_n_p): Use query-replace-map.
Richard M. Stallman <rms@gnu.org>
parents: 1919
diff changeset
2454 return answer ? Qt : Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2455 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2456
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2457 /* 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
2458 to redefined it.
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2459
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2460 Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2461
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2462 Lisp_Object
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2463 do_yes_or_no_p (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2464 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2465 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2466 return call1 (intern ("yes-or-no-p"), prompt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2467 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2468
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2469 /* Anything that calls this function must protect from GC! */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2470
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2471 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
759
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2472 "Ask user a yes-or-no question. Return t if answer is yes.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2473 Takes one argument, which is the string to display to ask the question.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2474 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
58b7fc91b74a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 727
diff changeset
2475 The user must confirm the answer with RET,\n\
11194
ca5effbebf81 (Fy_or_n_p): Don't log prompt.
Karl Heuer <kwzh@gnu.org>
parents: 11142
diff changeset
2476 and can edit it until it has been confirmed.")
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2477 (prompt)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2478 Lisp_Object prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2479 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2480 register Lisp_Object ans;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2481 Lisp_Object args[2];
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2482 struct gcpro gcpro1;
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
2483 Lisp_Object menu;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2484
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2485 CHECK_STRING (prompt, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2486
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
2487 #ifdef HAVE_MENUS
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2488 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
2489 && 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
2490 && 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
2491 {
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2492 Lisp_Object pane, menu, obj;
7815
5d167db8ce8a (Fy_or_n_p, Fyes_or_no_p) [HAVE_X_MENU]: Redisplay before popping up a menu.
Karl Heuer <kwzh@gnu.org>
parents: 7790
diff changeset
2493 redisplay_preserve_echo_area ();
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2494 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
2495 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
2496 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
2497 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
2498 menu = Fcons (prompt, pane);
6344
4ef6b636dc99 Whitespace change.
Richard M. Stallman <rms@gnu.org>
parents: 6303
diff changeset
2499 obj = Fx_popup_dialog (Qt, menu);
6057
b2cc63a56415 (Fy_or_n_p): Use a popup menu if reached via mouse command.
Richard M. Stallman <rms@gnu.org>
parents: 5664
diff changeset
2500 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
2501 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
2502 }
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
2503 #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
2504
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2505 args[0] = prompt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2506 args[1] = build_string ("(yes or no) ");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2507 prompt = Fconcat (2, args);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2508
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2509 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
2510
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2511 while (1)
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2512 {
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
2513 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
2514 Qyes_or_no_p_history, Qnil,
6d3cc8864678 (Fyes_or_no_p): Call Fread_from_minibuffer
Kenichi Handa <handa@m17n.org>
parents: 19383
diff changeset
2515 Qnil));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2516 if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2517 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2518 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2519 return Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2520 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2521 if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2522 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2523 UNGCPRO;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2524 return Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2525 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2526
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2527 Fding (Qnil);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2528 Fdiscard_input ();
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2529 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
2530 Fsleep_for (make_number (2), Qnil);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2531 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2532 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2533
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2534 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2535 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2536 Each of the three load averages is multiplied by 100,\n\
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2537 then converted to integer.\n\
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2538 When USE-FLOATS is non-nil, floats will be used instead of integers.\n\
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2539 These floats are not multiplied by 100.\n\n\
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2540 If the 5-minute or 15-minute load averages are not available, return a\n\
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2541 shortened list, containing only those averages which are available.")
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2542 (use_floats)
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2543 Lisp_Object use_floats;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2544 {
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2545 double load_ave[3];
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2546 int loads = getloadavg (load_ave, 3);
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2547 Lisp_Object ret = Qnil;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2548
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2549 if (loads < 0)
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2550 error ("load-average not implemented for this operating system");
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2551
21791
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2552 while (loads-- > 0)
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2553 {
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2554 Lisp_Object load = (NILP (use_floats) ?
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2555 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
2556 : make_float (load_ave[loads]));
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2557 ret = Fcons (load, ret);
ec09080bc3e1 (Fload_average): New arg USE_FLOATS.
Richard M. Stallman <rms@gnu.org>
parents: 21790
diff changeset
2558 }
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2559
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
2560 return ret;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2561 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2562
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2563 Lisp_Object Vfeatures;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2564
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2565 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2566 "Returns t if FEATURE is present in this Emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2567 Use this to conditionalize execution of lisp code based on the presence or\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2568 absence of emacs or environment extensions.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2569 Use `provide' to declare that a feature is available.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2570 This function looks at the value of the variable `features'.")
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2571 (feature)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2572 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2573 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2574 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2575 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2576 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2577 return (NILP (tem)) ? Qnil : Qt;
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2578 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2579
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2580 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2581 "Announce that FEATURE is a feature of the current Emacs.")
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2582 (feature)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2583 Lisp_Object feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2584 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2585 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2586 CHECK_SYMBOL (feature, 0);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2587 if (!NILP (Vautoload_queue))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2588 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2589 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2590 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2591 Vfeatures = Fcons (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2592 LOADHIST_ATTACH (Fcons (Qprovide, feature));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2593 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2594 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2595
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2596 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2597 "If feature FEATURE is not loaded, load it from FILENAME.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2598 If FEATURE is not a member of the list `features', then the feature\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2599 is not loaded; so load the file FILENAME.\n\
21577
027075cb9a49 (Frequire): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21523
diff changeset
2600 If FILENAME is omitted, the printname of FEATURE is used as the file name,\n\
027075cb9a49 (Frequire): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 21523
diff changeset
2601 but in this case `load' insists on adding the suffix `.el' or `.elc'.")
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2602 (feature, file_name)
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2603 Lisp_Object feature, file_name;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2604 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2605 register Lisp_Object tem;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2606 CHECK_SYMBOL (feature, 0);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2607 tem = Fmemq (feature, Vfeatures);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2608 LOADHIST_ATTACH (Fcons (Qrequire, feature));
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2609 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2610 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2611 int count = specpdl_ptr - specpdl;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2612
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2613 /* Value saved here is to be restored into Vautoload_queue */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2614 record_unwind_protect (un_autoload, Vautoload_queue);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2615 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2616
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2617 Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
19223
475cf041a683 (Frequire): Don't insist on a suffix
Richard M. Stallman <rms@gnu.org>
parents: 19117
diff changeset
2618 Qnil, Qt, Qnil, (NILP (file_name) ? Qt : Qnil));
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2619
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2620 tem = Fmemq (feature, Vfeatures);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 414
diff changeset
2621 if (NILP (tem))
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2622 error ("Required feature %s was not provided",
19223
475cf041a683 (Frequire): Don't insist on a suffix
Richard M. Stallman <rms@gnu.org>
parents: 19117
diff changeset
2623 XSYMBOL (feature)->name->data);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2624
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2625 /* Once loading finishes, don't undo it. */
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2626 Vautoload_queue = Qt;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2627 feature = unbind_to (count, feature);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2628 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2629 return feature;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2630 }
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2631
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2632 /* Primitives for work of the "widget" library.
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2633 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
2634 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
2635 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
2636 bottleneck of Widget operation. Here is their translation to C,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2637 for the sole reason of efficiency. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2638
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2639 DEFUN ("widget-plist-member", Fwidget_plist_member, Swidget_plist_member, 2, 2, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2640 "Return non-nil if PLIST has the property PROP.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2641 PLIST is a property list, which is a list of the form\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2642 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2643 Unlike `plist-get', this allows you to distinguish between a missing\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2644 property and a property with the value nil.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2645 The value is actually the tail of PLIST whose car is PROP.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2646 (plist, prop)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2647 Lisp_Object plist, prop;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2648 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2649 while (CONSP (plist) && !EQ (XCAR (plist), prop))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2650 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2651 QUIT;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2652 plist = XCDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2653 plist = CDR (plist);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2654 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2655 return plist;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2656 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2657
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2658 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2659 "In WIDGET, set PROPERTY to VALUE.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2660 The value can later be retrieved with `widget-get'.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2661 (widget, property, value)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2662 Lisp_Object widget, property, value;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2663 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2664 CHECK_CONS (widget, 1);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2665 XCDR (widget) = Fplist_put (XCDR (widget), property, value);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2666 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2667
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2668 DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2669 "In WIDGET, get the value of PROPERTY.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2670 The value could either be specified when the widget was created, or\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2671 later with `widget-put'.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2672 (widget, property)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2673 Lisp_Object widget, property;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2674 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2675 Lisp_Object tmp;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2676
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2677 while (1)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2678 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2679 if (NILP (widget))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2680 return Qnil;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2681 CHECK_CONS (widget, 1);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2682 tmp = Fwidget_plist_member (XCDR (widget), property);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2683 if (CONSP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2684 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2685 tmp = XCDR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2686 return CAR (tmp);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2687 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2688 tmp = XCAR (widget);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2689 if (NILP (tmp))
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2690 return Qnil;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2691 widget = Fget (tmp, Qwidget_type);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2692 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2693 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2694
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2695 DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0,
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2696 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2697 ARGS are passed as extra arguments to the function.")
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2698 (nargs, args)
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2699 int nargs;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2700 Lisp_Object *args;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2701 {
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2702 /* This function can GC. */
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2703 Lisp_Object newargs[3];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2704 struct gcpro gcpro1, gcpro2;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2705 Lisp_Object result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2706
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2707 newargs[0] = Fwidget_get (args[0], args[1]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2708 newargs[1] = args[0];
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2709 newargs[2] = Flist (nargs - 2, args + 2);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2710 GCPRO2 (newargs[0], newargs[2]);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2711 result = Fapply (3, newargs);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2712 UNGCPRO;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2713 return result;
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2714 }
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2715
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21383
diff changeset
2716 void
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2717 syms_of_fns ()
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2718 {
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2719 Qstring_lessp = intern ("string-lessp");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2720 staticpro (&Qstring_lessp);
2546
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2721 Qprovide = intern ("provide");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2722 staticpro (&Qprovide);
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2723 Qrequire = intern ("require");
c8cd694d70eb (provide, require): Put appropriately-marked
Richard M. Stallman <rms@gnu.org>
parents: 2525
diff changeset
2724 staticpro (&Qrequire);
4456
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
2725 Qyes_or_no_p_history = intern ("yes-or-no-p-history");
cbfcf187b5da (Fyes_or_no_p): Use Qyes_or_no_p_history.
Richard M. Stallman <rms@gnu.org>
parents: 4004
diff changeset
2726 staticpro (&Qyes_or_no_p_history);
14456
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2727 Qcursor_in_echo_area = intern ("cursor-in-echo-area");
fb11ccbe5c7c (Qcursor_in_echo_area): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14392
diff changeset
2728 staticpro (&Qcursor_in_echo_area);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2729 Qwidget_type = intern ("widget-type");
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2730 staticpro (&Qwidget_type);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2731
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
2732 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
2733 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
2734
14486
3c4ba112108e (syms_of_fns): Set yes-or-no-p-history to nil.
Richard M. Stallman <rms@gnu.org>
parents: 14456
diff changeset
2735 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
2736
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2737 DEFVAR_LISP ("features", &Vfeatures,
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2738 "A list of symbols which are the features of the executing emacs.\n\
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2739 Used by `featurep' and `require', and altered by `provide'.");
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2740 Vfeatures = Qnil;
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2741
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
2742 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
2743 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
18686
186f1b58028d (syms_of_fns): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 18613
diff changeset
2744 This applies to y-or-n and yes-or-no questions asked by commands\n\
18531
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
2745 invoked by mouse clicks and mouse menu items.");
35a263e545b3 (Fy_or_n_p, Fyes_or_no_p): Obey use_dialog_box.
Richard M. Stallman <rms@gnu.org>
parents: 18421
diff changeset
2746 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
2747
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2748 defsubr (&Sidentity);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2749 defsubr (&Srandom);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2750 defsubr (&Slength);
12466
b22565172b9b (Fsafe_length): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12062
diff changeset
2751 defsubr (&Ssafe_length);
20864
ad9e06c97d95 (Fstring_bytes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20814
diff changeset
2752 defsubr (&Sstring_bytes);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2753 defsubr (&Sstring_equal);
21671
c359a549f2d2 (Fcompare_strings): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21580
diff changeset
2754 defsubr (&Scompare_strings);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2755 defsubr (&Sstring_lessp);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2756 defsubr (&Sappend);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2757 defsubr (&Sconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2758 defsubr (&Svconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2759 defsubr (&Scopy_sequence);
20667
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
2760 defsubr (&Sstring_make_multibyte);
64af046211eb (concat): Move the test for all nil in `append'
Karl Heuer <kwzh@gnu.org>
parents: 20639
diff changeset
2761 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
2762 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
2763 defsubr (&Sstring_as_unibyte);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2764 defsubr (&Scopy_alist);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2765 defsubr (&Ssubstring);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2766 defsubr (&Snthcdr);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2767 defsubr (&Snth);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2768 defsubr (&Selt);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2769 defsubr (&Smember);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2770 defsubr (&Smemq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2771 defsubr (&Sassq);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2772 defsubr (&Sassoc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2773 defsubr (&Srassq);
10588
2a8f29cd9e9f (Frassoc): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10485
diff changeset
2774 defsubr (&Srassoc);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2775 defsubr (&Sdelq);
414
4c9349866dac *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 401
diff changeset
2776 defsubr (&Sdelete);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2777 defsubr (&Snreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2778 defsubr (&Sreverse);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2779 defsubr (&Ssort);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2780 defsubr (&Splist_get);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2781 defsubr (&Sget);
11130
052869c2f609 (Fplist_put, Fplist_get): New fns.
Boris Goldowsky <boris@gnu.org>
parents: 11094
diff changeset
2782 defsubr (&Splist_put);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2783 defsubr (&Sput);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2784 defsubr (&Sequal);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2785 defsubr (&Sfillarray);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2786 defsubr (&Schar_table_subtype);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2787 defsubr (&Schar_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2788 defsubr (&Sset_char_table_parent);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2789 defsubr (&Schar_table_extra_slot);
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2790 defsubr (&Sset_char_table_extra_slot);
13236
c9af99bb26d4 (Fchar_table_subtype): New function.
Richard M. Stallman <rms@gnu.org>
parents: 13184
diff changeset
2791 defsubr (&Schar_table_range);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2792 defsubr (&Sset_char_table_range);
17826
961399e23170 (copy_sub_char_table): Declare the argument ARG as
Kenichi Handa <handa@m17n.org>
parents: 17819
diff changeset
2793 defsubr (&Sset_char_table_default);
13140
99c5d39b9531 (Fset_char_table_range): New function.
Richard M. Stallman <rms@gnu.org>
parents: 12618
diff changeset
2794 defsubr (&Smap_char_table);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2795 defsubr (&Snconc);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2796 defsubr (&Smapcar);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2797 defsubr (&Smapconcat);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2798 defsubr (&Sy_or_n_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2799 defsubr (&Syes_or_no_p);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2800 defsubr (&Sload_average);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2801 defsubr (&Sfeaturep);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2802 defsubr (&Srequire);
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2803 defsubr (&Sprovide);
20004
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2804 defsubr (&Swidget_plist_member);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2805 defsubr (&Swidget_put);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2806 defsubr (&Swidget_get);
de15e679191e (Qwidget_type): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 19573
diff changeset
2807 defsubr (&Swidget_apply);
211
d7da9e79438f Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2808 }