annotate src/fns.c @ 814:a634e3b7acc8

[xemacs-hg @ 2002-04-14 12:41:59 by ben] latest changes TODO.ben-mule-21-5: Update. make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse the basic charset designation sequences so we know whether we're in ASCII and have to pay attention to end quotes and such. Reformat code according to coding standards. abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if non-nil, defining an abbrev through an interactive function will automatically turn on abbrev-mode, either globally or locally depending on the command. This is the "what you'd expect" behavior. indent.el: general function for indenting a balanced expression in a mode-correct way. Works similar to indent-region in that a mode can specify a specific command to do the whole operation; if not, figure out the region using forward-sexp and indent each line using indent-according-to-mode. keydefs.el: Removed. Modify M-C-backslash to do indent-region-or-balanced-expression. Make S-Tab just insert a TAB char, like it's meant to do. make-docfile.el: Now that we're using the call-process-in-lisp, we need to load an extra file win32-native.el because we're running a bare temacs. menubar-items.el: Totally redo the Cmds menu so that most used commands appear directly on the menu and less used commands appear in submenus. The old way may have been very pretty, but rather impractical. process.el: Under Windows, don't ever use old-call-process-internal, even in batch mode. We can do processes in batch mode. subr.el: Someone recoded truncate-string-to-width, saying "the FSF version is too complicated and does lots of hard-to-understand stuff" but the resulting recoded version was *totally* wrong! it misunderstood the basic point of this function, which is work in *columns* not chars. i dumped ours and copied the version from FSF 21.1. Also added truncate-string-with-continuation-dots, since this idiom is used often. config.inc.samp, xemacs.mak: Separate out debug and optimize flags. Remove all vestiges of USE_MINIMAL_TAGBITS, USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those ifdefs have long been removed. Make error-checking support actually work. Some rearrangement of config.inc.samp to make it more logical. Remove callproc.c and ntproc.c from xemacs.mak, no longer used. Make pdump the default. lisp.h: Add support for strong type-checking of Bytecount, Bytebpos, Charcount, Charbpos, and others, by making them classes, overloading the operators to provide integer-like operation and carefully controlling what operations are allowed. Not currently enabled in C++ builds because there are still a number of compile errors, and it won't really work till we merge in my "8-bit-Mule" workspace, in which I make use of the new types Charxpos, Bytexpos, Memxpos, representing a "position" either in a buffer or a string. (This is especially important in the extent code.) abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type checking of Bytecount, Charbpos, etc. dired.c: Caught an actual error due to strong type checking -- char len being passed when should be byte len. alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall: -- process arg list at compiled-function creation time, converting into an array for extra-quick access at funcall time. -- rewrite funcall_compiled_function to use it, and inline this function. -- change the order of check for magic stuff in SPECBIND_FAST_UNSAFE to be faster. -- move the check for need to garbage collect into the allocation code, so only a single flag needs to be checked in funcall. buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and strings. eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under pdump. Redo a bit some of the init routines; convert some complex_vars_of() into simple vars_of(), because they didn't need complex processing. callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god but Allah!!! fix so that processes can be invoked in bare temacs -- thereby eliminating any need for callproc.c. (currently only eliminated under NT.) remove all crufty and unnecessary old process code in ntproc.c and elsewhere. move non-callproc-specific stuff (mostly environment) into process.c, so callproc.c can be left out under NT. console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs. change handling of "character mode" so callers don't have to manually set it (quite error-prone). event-msw.c: spacing fixes. lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code. lrecord.h: improve pdump description docs. buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized before by simply always calling the ...A versions of functions, but that won't cut it -- eventually we want to be able to run properly even if XEmacs has been installed in a Japanese directory. (The current problem is the timing of the loading of the Unicode tables; this will eventually be fixed.) Go through and fix various other places where the code was not Mule-clean. Provide a function mswindows_get_module_file_name() to get our own name without resort to PATH_MAX and such. Add a big comment in main() about the problem with Unicode table load timing that I just alluded to. emacs.c: When error-checking is enabled (interpreted as "user is developing XEmacs"), don't ask user to "pause to read messages" when a fatal error has occurred, because it will wedge if we are in an inner modal loop (typically when a menu is popped up) and make us unable to get a useful stack trace in the debugger. text.c: Correct update_entirely_ascii_p_flag to actually work. lisp.h, symsinit.h: declarations for above changes.
author ben
date Sun, 14 Apr 2002 12:43:31 +0000
parents 2b676dc88c66
children 6728e641994e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Random utility Lisp functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3 Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 /* Note: FSF 19.30 has bool vectors. We have bit vectors. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 /* Hacked on for Mule by Ben Wing, December 1994, January 1995. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 /* Note on some machines this defines `vector' as a typedef,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 so make sure we don't use that name in this file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #undef vector
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #define vector *****
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
39 #include "sysfile.h"
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
40 #include "sysproc.h" /* for qxe_getpid() */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #include "device.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "extents.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 /* NOTE: This symbol is also used in lread.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #define FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Lisp_Object Qstring_lessp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object Qidentity;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
59 Lisp_Object Qbase64_conversion_error;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
60
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
61 Lisp_Object Vpath_separator;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
62
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
64 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
66 int require_prints_loading_message;
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
67
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 mark_bit_vector (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
77 Elemcount i;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
78 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
79 Elemcount len = bit_vector_length (v);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
80 Elemcount last = len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 if (INTP (Vprint_length))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 last = min (len, XINT (Vprint_length));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 write_c_string ("#*", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 for (i = 0; i < last; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 if (bit_vector_bit (v, i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 write_c_string ("1", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 write_c_string ("0", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 if (last != len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 write_c_string ("...", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
100 Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
101 Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 !memcmp (v1->bits, v2->bits,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 sizeof (long)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
109 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 bit_vector_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
112 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 return HASH2 (bit_vector_length (v),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 memory_hash (v->bits,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 sizeof (long)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
119 static Bytecount
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
120 size_bit_vector (const void *lheader)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
121 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
122 Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader;
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 454
diff changeset
123 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
124 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
125 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
126
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 static const struct lrecord_description bit_vector_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
128 { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
133 DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION ("bit-vector", bit_vector,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
134 mark_bit_vector, print_bit_vector, 0,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
135 bit_vector_equal, bit_vector_hash,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
136 bit_vector_description, size_bit_vector,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
137 Lisp_Bit_Vector);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 DEFUN ("identity", Fidentity, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Return the argument unchanged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 return arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 DEFUN ("random", Frandom, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Return a pseudo-random number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 All integers representable in Lisp are equally likely.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 On most systems, this is 28 bits' worth.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 With positive integer argument N, return random number in interval [0,N).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 With argument t, set the random number seed from the current time and pid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (limit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 EMACS_INT val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 unsigned long denominator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 if (EQ (limit, Qt))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
160 seed_random (qxe_getpid () + time (NULL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 if (NATNUMP (limit) && !ZEROP (limit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 /* Try to take our random number from the higher bits of VAL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 not the lower, since (says Gentzel) the low bits of `random'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 are less random than the higher ones. We do this by using the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 quotient rather than the remainder. At the high end of the RNG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 it's possible to get a quotient larger than limit; discarding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 these values eliminates the bias that would otherwise appear
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 when using a large limit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 denominator = ((unsigned long)1 << VALBITS) / XINT (limit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 val = get_random () / denominator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 while (val >= XINT (limit));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 val = get_random ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 return make_int (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 /* Random data-structure functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 /* #### Delete this shit */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 /* Charcount is a misnomer here as we might be dealing with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 length of a vector or list, but emphasizes that we're not dealing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 with Bytecounts in strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 static Charcount
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 length_with_bytecode_hack (Lisp_Object seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 if (!COMPILED_FUNCTIONP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 return XINT (Flength (seq));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
197 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 return (f->flags.interactivep ? COMPILED_INTERACTIVE :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 f->flags.domainp ? COMPILED_DOMAIN :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 COMPILED_DOC_STRING)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 #endif /* LOSING_BYTECODE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
209 check_losing_bytecode (const char *function, Lisp_Object seq)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 if (COMPILED_FUNCTIONP (seq))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
212 signal_ferror_with_frob
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
213 (Qinvalid_argument, seq,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 "As of 20.3, `%s' no longer works with compiled-function objects",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 DEFUN ("length", Flength, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Return the length of vector, bit vector, list or string SEQUENCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 if (STRINGP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 return make_int (XSTRING_CHAR_LENGTH (sequence));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 else if (CONSP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
228 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 GET_EXTERNAL_LIST_LENGTH (sequence, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 return make_int (len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 else if (VECTORP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 return make_int (XVECTOR_LENGTH (sequence));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 else if (NILP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 else if (BIT_VECTORP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 return make_int (bit_vector_length (XBIT_VECTOR (sequence)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 check_losing_bytecode ("length", sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 sequence = wrong_type_argument (Qsequencep, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 DEFUN ("safe-length", Fsafe_length, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 Return the length of a list, but avoid error or infinite loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 This function never gets an error. If LIST is not really a list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 it returns 0. If LIST is circular, it returns a finite value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 which is at least the number of distinct elements.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 Lisp_Object hare, tortoise;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
255 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 for (hare = tortoise = list, len = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 hare = XCDR (hare), len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 return make_int (len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 /*** string functions. ***/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 Return t if two strings have identical contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 Case is significant. Text properties are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 \(Under XEmacs, `equal' also ignores text properties and extents in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 strings, but this is not the case under FSF Emacs 19. In FSF Emacs 20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 `equal' is the same as in XEmacs, in that respect.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 Symbols are also allowed; their print names are used instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
278 (string1, string2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 Bytecount len;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
281 Lisp_Object p1, p2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
283 if (SYMBOLP (string1))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
284 p1 = XSYMBOL (string1)->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
287 CHECK_STRING (string1);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
288 p1 = string1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
291 if (SYMBOLP (string2))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
292 p2 = XSYMBOL (string2)->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
295 CHECK_STRING (string2);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
296 p2 = string2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
299 return (((len = XSTRING_LENGTH (p1)) == XSTRING_LENGTH (p2)) &&
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
300 !memcmp (XSTRING_DATA (p1), XSTRING_DATA (p2), len)) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
303 DEFUN ("compare-strings", Fcompare_strings, 6, 7, 0, /*
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
304 Compare the contents of two strings, maybe ignoring case.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
305 In string STR1, skip the first START1 characters and stop at END1.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
306 In string STR2, skip the first START2 characters and stop at END2.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
307 END1 and END2 default to the full lengths of the respective strings.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
308
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
309 Case is significant in this comparison if IGNORE-CASE is nil.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
310
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
311 The value is t if the strings (or specified portions) match.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
312 If string STR1 is less, the value is a negative number N;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
313 - 1 - N is the number of characters that match at the beginning.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
314 If string STR1 is greater, the value is a positive number N;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
315 N - 1 is the number of characters that match at the beginning.
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
316 */
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
317 (str1, start1, end1, str2, start2, end2, ignore_case))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
318 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
319 Charcount ccstart1, ccend1, ccstart2, ccend2;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
320 Bytecount bstart1, blen1, bstart2, blen2;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
321 Charcount matching;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
322 int res;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
323
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
324 CHECK_STRING (str1);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
325 CHECK_STRING (str2);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
326 get_string_range_char (str1, start1, end1, &ccstart1, &ccend1,
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
327 GB_HISTORICAL_STRING_BEHAVIOR);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
328 get_string_range_char (str2, start2, end2, &ccstart2, &ccend2,
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
329 GB_HISTORICAL_STRING_BEHAVIOR);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
330
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
331 bstart1 = string_index_char_to_byte (str1, ccstart1);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
332 blen1 = string_offset_char_to_byte_len (str1, bstart1, ccend1 - ccstart1);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
333 bstart2 = string_index_char_to_byte (str2, ccstart2);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
334 blen2 = string_offset_char_to_byte_len (str2, bstart2, ccend2 - ccstart2);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
335
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
336 res = ((NILP (ignore_case) ? qxetextcmp_matching : qxetextcasecmp_matching)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
337 (XSTRING_DATA (str1) + bstart1, blen1,
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
338 XSTRING_DATA (str2) + bstart2, blen2,
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
339 &matching));
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
340
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
341 if (!res)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
342 return Qt;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
343 else if (res > 0)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
344 return make_int (1 + matching);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
345 else
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
346 return make_int (-1 - matching);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
347 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
348
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 Return t if first arg string is less than second in lexicographic order.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
351 Comparison is simply done on a character-by-character basis using the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
352 numeric value of a character. (Note that this may not produce
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
353 particularly meaningful results under Mule if characters from
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
354 different charsets are being compared.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 Symbols are also allowed; their print names are used instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
358 Currently we don't do proper language-specific collation or handle
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
359 multiple character sets. This may be changed when Unicode support
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
360 is implemented.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
362 (string1, string2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
364 Lisp_Object p1, p2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 Charcount end, len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
368 if (SYMBOLP (string1))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
369 p1 = XSYMBOL (string1)->name;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
370 else
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
371 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
372 CHECK_STRING (string1);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
373 p1 = string1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
376 if (SYMBOLP (string2))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
377 p2 = XSYMBOL (string2)->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
380 CHECK_STRING (string2);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
381 p2 = string2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
384 end = XSTRING_CHAR_LENGTH (p1);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
385 len2 = XSTRING_CHAR_LENGTH (p2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 if (end > len2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 end = len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
390 Intbyte *ptr1 = XSTRING_DATA (p1);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
391 Intbyte *ptr2 = XSTRING_DATA (p2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 /* #### It is not really necessary to do this: We could compare
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 byte-by-byte and still get a reasonable comparison, since this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 would compare characters with a charset in the same way. With
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 a little rearrangement of the leading bytes, we could make most
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 inter-charset comparisons work out the same, too; even if some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 don't, this is not a big deal because inter-charset comparisons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 aren't really well-defined anyway. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 for (i = 0; i < end; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 if (charptr_emchar (ptr1) != charptr_emchar (ptr2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 return charptr_emchar (ptr1) < charptr_emchar (ptr2) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 INC_CHARPTR (ptr1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 INC_CHARPTR (ptr2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 /* Can't do i < len2 because then comparison between "foo" and "foo^@"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 won't work right in I18N2 case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 return end < len2 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 DEFUN ("string-modified-tick", Fstring_modified_tick, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 Return STRING's tick counter, incremented for each change to the string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 Each string has a tick counter which is incremented each time the contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 of the string are changed (e.g. with `aset'). It wraps around occasionally.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 CHECK_STRING (string);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
421 if (CONSP (XSTRING_PLIST (string)) && INTP (XCAR (XSTRING_PLIST (string))))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
422 return XCAR (XSTRING_PLIST (string));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 bump_string_modiff (Lisp_Object str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
430 Lisp_Object *ptr = &XSTRING_PLIST (str);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 /* #### remove the `string-translatable' property from the string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 if there is one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 /* skip over extent info if it's there */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 ptr = &XCDR (*ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 if (CONSP (*ptr) && INTP (XCAR (*ptr)))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
440 XCAR (*ptr) = make_int (1+XINT (XCAR (*ptr)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 *ptr = Fcons (make_int (1), *ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 enum concat_target_type { c_cons, c_string, c_vector, c_bit_vector };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 static Lisp_Object concat (int nargs, Lisp_Object *args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 enum concat_target_type target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 int last_special);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
452 concat2 (Lisp_Object string1, Lisp_Object string2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 Lisp_Object args[2];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
455 args[0] = string1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
456 args[1] = string2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 return concat (2, args, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
461 concat3 (Lisp_Object string1, Lisp_Object string2, Lisp_Object string3)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 Lisp_Object args[3];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
464 args[0] = string1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
465 args[1] = string2;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
466 args[2] = string3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 return concat (3, args, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
471 vconcat2 (Lisp_Object vec1, Lisp_Object vec2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 Lisp_Object args[2];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
474 args[0] = vec1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
475 args[1] = vec2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 return concat (2, args, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
480 vconcat3 (Lisp_Object vec1, Lisp_Object vec2, Lisp_Object vec3)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 Lisp_Object args[3];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
483 args[0] = vec1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
484 args[1] = vec2;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
485 args[2] = vec3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 return concat (3, args, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 DEFUN ("append", Fappend, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 Concatenate all the arguments and make the result a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 The result is a list whose elements are the elements of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 Each argument may be a list, vector, bit vector, or string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 The last argument is not copied, just used as the tail of the new list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 Also see: `nconc'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 return concat (nargs, args, c_cons, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 DEFUN ("concat", Fconcat, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 Concatenate all the arguments and make the result a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 The result is a string whose elements are the elements of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 Each argument may be a string or a list or vector of characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 As of XEmacs 21.0, this function does NOT accept individual integers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 as arguments. Old code that relies on, for example, (concat "foo" 50)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 returning "foo50" will fail. To fix such code, either apply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 `int-to-string' to the integer argument, or use `format'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 return concat (nargs, args, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 DEFUN ("vconcat", Fvconcat, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 Concatenate all the arguments and make the result a vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 The result is a vector whose elements are the elements of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 Each argument may be a list, vector, bit vector, or string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 return concat (nargs, args, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 DEFUN ("bvconcat", Fbvconcat, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 Concatenate all the arguments and make the result a bit vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 The result is a bit vector whose elements are the elements of all the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 arguments. Each argument may be a list, vector, bit vector, or string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 return concat (nargs, args, c_bit_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 /* Copy a (possibly dotted) list. LIST must be a cons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 Can't use concat (1, &alist, c_cons, 0) - doesn't handle dotted lists. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 copy_list (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 Lisp_Object last = list_copy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 Lisp_Object hare, tortoise;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
544 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 for (tortoise = hare = XCDR (list), len = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 CONSP (hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 hare = XCDR (hare), len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 XCDR (last) = Fcons (XCAR (hare), XCDR (hare));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 last = XCDR (last);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 if (len < CIRCULAR_LIST_SUSPICION_LENGTH)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 if (EQ (tortoise, hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 signal_circular_list_error (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 return list_copy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 DEFUN ("copy-list", Fcopy_list, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 Return a copy of list LIST, which may be a dotted list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 The elements of LIST are not copied; they are shared
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 with the original.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 if (NILP (list)) return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 if (CONSP (list)) return copy_list (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 list = wrong_type_argument (Qlistp, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 goto again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 Return a copy of list, vector, bit vector or string SEQUENCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 The elements of a list or vector are not copied; they are shared
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 with the original. SEQUENCE may be a dotted list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 if (NILP (sequence)) return sequence;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 if (CONSP (sequence)) return copy_list (sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 if (STRINGP (sequence)) return concat (1, &sequence, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 if (VECTORP (sequence)) return concat (1, &sequence, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 if (BIT_VECTORP (sequence)) return concat (1, &sequence, c_bit_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 check_losing_bytecode ("copy-sequence", sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 sequence = wrong_type_argument (Qsequencep, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 goto again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 struct merge_string_extents_struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 Lisp_Object string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 Bytecount entry_offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 Bytecount entry_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 concat (int nargs, Lisp_Object *args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 enum concat_target_type target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 int last_special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 Lisp_Object tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 int toindex;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 Lisp_Object last_tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 Lisp_Object prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 struct merge_string_extents_struct *args_mse = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
617 Intbyte *string_result = 0;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
618 Intbyte *string_result_ptr = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 /* The modus operandi in Emacs is "caller gc-protects args".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 However, concat is called many times in Emacs on freshly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 created stuff. So we help those callers out by protecting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 the args ourselves to save them a lot of temporary-variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 grief. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 GCPRO1 (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 gcpro1.nvars = nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 /* #### if the result is a string and any of the strings have a string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 for the `string-translatable' property, then concat should also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 concat the args but use the `string-translatable' strings, and store
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 the result in the returned string's `string-translatable' property. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 if (target_type == c_string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 args_mse = alloca_array (struct merge_string_extents_struct, nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 /* In append, the last arg isn't treated like the others */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 if (last_special && nargs > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 nargs--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 last_tail = args[nargs];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 last_tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 /* Check and coerce the arguments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 Lisp_Object seq = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 if (LISTP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 else if (VECTORP (seq) || STRINGP (seq) || BIT_VECTORP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 else if (COMPILED_FUNCTIONP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 /* Urk! We allow this, for "compatibility"... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 #if 0 /* removed for XEmacs 21 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 else if (INTP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 /* This is too revolting to think about but maintains
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 compatibility with FSF (and lots and lots of old code). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 args[argnum] = Fnumber_to_string (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 check_losing_bytecode ("concat", seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 args[argnum] = wrong_type_argument (Qsequencep, seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 if (args_mse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 if (STRINGP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 args_mse[argnum].string = seq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 args_mse[argnum].string = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 /* Charcount is a misnomer here as we might be dealing with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 length of a vector or list, but emphasizes that we're not dealing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 with Bytecounts in strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 Charcount total_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 for (argnum = 0, total_length = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 Charcount thislen = length_with_bytecode_hack (args[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 Charcount thislen = XINT (Flength (args[argnum]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 total_length += thislen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 switch (target_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 case c_cons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 if (total_length == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 /* In append, if all but last arg are nil, return last arg */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 RETURN_UNGCPRO (last_tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 val = Fmake_list (make_int (total_length), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 case c_vector:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 val = make_vector (total_length, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 case c_bit_vector:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 val = make_bit_vector (total_length, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 case c_string:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 /* We don't make the string yet because we don't know the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 actual number of bytes. This loop was formerly written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 to call Fmake_string() here and then call set_string_char()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 for each char. This seems logical enough but is waaaaaaaay
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 slow -- set_string_char() has to scan the whole string up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 to the place where the substitution is called for in order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 to find the place to change, and may have to do some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 realloc()ing in order to make the char fit properly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 O(N^2) yuckage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 val = Qnil;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
723 string_result = (Intbyte *) alloca (total_length * MAX_EMCHAR_LEN);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 string_result_ptr = string_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 default:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
727 val = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 if (CONSP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 tail = val, toindex = -1; /* -1 in toindex is flag we are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 making a list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 toindex = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 Charcount thisleni = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 Charcount thisindex = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 Lisp_Object seq = args[argnum];
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
746 Intbyte *string_source_ptr = 0;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
747 Intbyte *string_prev_result_ptr = string_result_ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 if (!CONSP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 thisleni = length_with_bytecode_hack (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 thisleni = XINT (Flength (seq));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 if (STRINGP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 string_source_ptr = XSTRING_DATA (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 Lisp_Object elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 /* We've come to the end of this arg, so exit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 if (NILP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 /* Fetch next element of `seq' arg into `elt' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 if (CONSP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 elt = XCAR (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 seq = XCDR (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 if (thisindex >= thisleni)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 if (STRINGP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 elt = make_char (charptr_emchar (string_source_ptr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 INC_CHARPTR (string_source_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 else if (VECTORP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 elt = XVECTOR_DATA (seq)[thisindex];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 else if (BIT_VECTORP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 elt = make_int (bit_vector_bit (XBIT_VECTOR (seq),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 thisindex));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 elt = Felt (seq, make_int (thisindex));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 thisindex++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 /* Store into result */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 if (toindex < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 /* toindex negative means we are making a list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 XCAR (tail) = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 else if (VECTORP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 XVECTOR_DATA (val)[toindex++] = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 else if (BIT_VECTORP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 CHECK_BIT (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 set_bit_vector_bit (XBIT_VECTOR (val), toindex++, XINT (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 CHECK_CHAR_COERCE_INT (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 string_result_ptr += set_charptr_emchar (string_result_ptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 XCHAR (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 if (args_mse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 args_mse[argnum].entry_offset =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 string_prev_result_ptr - string_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 args_mse[argnum].entry_length =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 string_result_ptr - string_prev_result_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 /* Now we finally make the string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 if (target_type == c_string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 val = make_string (string_result, string_result_ptr - string_result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 if (STRINGP (args_mse[argnum].string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 copy_string_extents (val, args_mse[argnum].string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 args_mse[argnum].entry_offset, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 args_mse[argnum].entry_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 if (!NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 XCDR (prev) = last_tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 RETURN_UNGCPRO (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 DEFUN ("copy-alist", Fcopy_alist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 Return a copy of ALIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 This is an alist which represents the same mapping from objects to objects,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 but does not share the alist structure with ALIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 The objects mapped (cars and cdrs of elements of the alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 are shared, however.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 Elements of ALIST that are not conses are also shared.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 (alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 if (NILP (alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 return alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 CHECK_CONS (alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 alist = concat (1, &alist, c_cons, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 for (tail = alist; CONSP (tail); tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 Lisp_Object car = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 if (CONSP (car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 XCAR (tail) = Fcons (XCAR (car), XCDR (car));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 return alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 Return a copy of a list and substructures.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 The argument is copied, and any lists contained within it are copied
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 recursively. Circularities and shared substructures are not preserved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 Second arg VECP causes vectors to be copied, too. Strings and bit vectors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 are not copied.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (arg, vecp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
880 return safe_copy_tree (arg, vecp, 0);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
881 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
882
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
883 Lisp_Object
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
884 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
885 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
886 if (depth > 200)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
887 stack_overflow ("Stack overflow in copy-tree", arg);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
888
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 if (CONSP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 rest = arg = Fcopy_sequence (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 while (CONSP (rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 Lisp_Object elt = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 if (CONSP (elt) || VECTORP (elt))
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
898 XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
900 XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 rest = XCDR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 else if (VECTORP (arg) && ! NILP (vecp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 int i = XVECTOR_LENGTH (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 arg = Fcopy_sequence (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 for (j = 0; j < i; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Lisp_Object elt = XVECTOR_DATA (arg) [j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 if (CONSP (elt) || VECTORP (elt))
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
914 XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 return arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 DEFUN ("substring", Fsubstring, 2, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
921 Return the substring of STRING starting at START and ending before END.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
922 END may be nil or omitted; then the substring runs to the end of STRING.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
923 If START or END is negative, it counts from the end.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
924 Relevant parts of the string-extent-data are copied to the new string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
926 (string, start, end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
928 Charcount ccstart, ccend;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
929 Bytecount bstart, blen;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 CHECK_STRING (string);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
933 CHECK_INT (start);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
934 get_string_range_char (string, start, end, &ccstart, &ccend,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 GB_HISTORICAL_STRING_BEHAVIOR);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
936 bstart = string_index_char_to_byte (string, ccstart);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
937 blen = string_offset_char_to_byte_len (string, bstart, ccend - ccstart);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
938 val = make_string (XSTRING_DATA (string) + bstart, blen);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
939 /* Copy any applicable extent information into the new string. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
940 copy_string_extents (val, string, 0, bstart, blen);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 Return the subsequence of SEQUENCE starting at START and ending before END.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 END may be omitted; then the subsequence runs to the end of SEQUENCE.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 If START or END is negative, it counts from the end.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 The returned subsequence is always of the same type as SEQUENCE.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 If SEQUENCE is a string, relevant parts of the string-extent-data
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 are copied to the new string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
952 (sequence, start, end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954 EMACS_INT len, s, e;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
956 if (STRINGP (sequence))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
957 return Fsubstring (sequence, start, end);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
958
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
959 len = XINT (Flength (sequence));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
960
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
961 CHECK_INT (start);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962 s = XINT (start);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
963 if (s < 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
964 s = len + s;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
965
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
966 if (NILP (end))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
967 e = len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
970 CHECK_INT (end);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
971 e = XINT (end);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
972 if (e < 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
973 e = len + e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
976 if (!(0 <= s && s <= e && e <= len))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
977 args_out_of_range_3 (sequence, make_int (s), make_int (e));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
978
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
979 if (VECTORP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981 Lisp_Object result = make_vector (e - s, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 EMACS_INT i;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
983 Lisp_Object *in_elts = XVECTOR_DATA (sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 Lisp_Object *out_elts = XVECTOR_DATA (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
986 for (i = s; i < e; i++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
987 out_elts[i - s] = in_elts[i];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
990 else if (LISTP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 EMACS_INT i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
995 sequence = Fnthcdr (make_int (s), sequence);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
996
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
997 for (i = s; i < e; i++)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
999 result = Fcons (Fcar (sequence), result);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1000 sequence = Fcdr (sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 return Fnreverse (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1005 else if (BIT_VECTORP (sequence))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1006 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1007 Lisp_Object result = make_bit_vector (e - s, Qzero);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1008 EMACS_INT i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1009
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1010 for (i = s; i < e; i++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1011 set_bit_vector_bit (XBIT_VECTOR (result), i - s,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1012 bit_vector_bit (XBIT_VECTOR (sequence), i));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1013 return result;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1014 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1015 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1016 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1017 abort (); /* unreachable, since Flength (sequence) did not get
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1018 an error */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1019 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1020 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1023 /* Split STRING into a list of substrings. The substrings are the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1024 parts of original STRING separated by SEPCHAR. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1025 static Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1026 split_string_by_emchar_1 (const Intbyte *string, Bytecount size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1027 Emchar sepchar)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1028 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1029 Lisp_Object result = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1030 const Intbyte *end = string + size;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1031
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1032 while (1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1033 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1034 const Intbyte *p = string;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1035 while (p < end)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1036 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1037 if (charptr_emchar (p) == sepchar)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1038 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1039 INC_CHARPTR (p);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1040 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1041 result = Fcons (make_string (string, p - string), result);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1042 if (p < end)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1043 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1044 string = p;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1045 INC_CHARPTR (string); /* skip sepchar */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1046 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1047 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1048 break;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1049 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1050 return Fnreverse (result);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1051 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1052
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1053 /* The same as the above, except PATH is an external C string (it is
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1054 converted using Qfile_name), and sepchar is hardcoded to SEPCHAR
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1055 (':' or whatever). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1056 Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1057 split_external_path (const Extbyte *path)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1058 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1059 Bytecount newlen;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1060 Intbyte *newpath;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1061 if (!path)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1062 return Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1063
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1064 TO_INTERNAL_FORMAT (C_STRING, path, ALLOCA, (newpath, newlen), Qfile_name);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1065
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1066 /* #### Does this make sense? It certainly does for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1067 split_env_path(), but it looks dubious here. Does any code
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1068 depend on split_external_path("") returning nil instead of an empty
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1069 string? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1070 if (!newlen)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1071 return Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1072
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1073 return split_string_by_emchar_1 (newpath, newlen, SEPCHAR);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1074 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1075
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1076 Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1077 split_env_path (const CIntbyte *evarname, const Intbyte *default_)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1078 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1079 const Intbyte *path = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1080 if (evarname)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1081 path = egetenv (evarname);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1082 if (!path)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1083 path = default_;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1084 if (!path)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1085 return Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1086 return split_string_by_emchar_1 (path, qxestrlen (path), SEPCHAR);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1087 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1088
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1089 /* Ben thinks this function should not exist or be exported to Lisp.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1090 We use it to define split-path-string in subr.el (not!). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1091
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1092 DEFUN ("split-string-by-char", Fsplit_string_by_char, 1, 2, 0, /*
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1093 Split STRING into a list of substrings originally separated by SEPCHAR.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1094 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1095 (string, sepchar))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1096 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1097 CHECK_STRING (string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1098 CHECK_CHAR (sepchar);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1099 return split_string_by_emchar_1 (XSTRING_DATA (string),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1100 XSTRING_LENGTH (string),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1101 XCHAR (sepchar));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1102 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1103
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1104 /* #### This was supposed to be in subr.el, but is used VERY early in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1105 the bootstrap process, so it goes here. Damn. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1106
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1107 DEFUN ("split-path", Fsplit_path, 1, 1, 0, /*
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1108 Explode a search path into a list of strings.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1109 The path components are separated with the characters specified
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1110 with `path-separator'.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1111 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1112 (path))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1113 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1114 CHECK_STRING (path);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1115
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1116 while (!STRINGP (Vpath_separator)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1117 || (XSTRING_CHAR_LENGTH (Vpath_separator) != 1))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1118 Vpath_separator = signal_continuable_error
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1119 (Qinvalid_state,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1120 "`path-separator' should be set to a single-character string",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1121 Vpath_separator);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1122
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1123 return (split_string_by_emchar_1
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1124 (XSTRING_DATA (path), XSTRING_LENGTH (path),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1125 charptr_emchar (XSTRING_DATA (Vpath_separator))));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1126 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1127
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 Take cdr N times on LIST, and return the result.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 (n, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1134 REGISTER EMACS_INT i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 for (i = XINT (n); i; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 if (CONSP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 else if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 tail = wrong_type_argument (Qlistp, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 i++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 DEFUN ("nth", Fnth, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 Return the Nth element of LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 N counts from zero. If LIST is not that long, nil is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 (n, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 return Fcar (Fnthcdr (n, list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 DEFUN ("elt", Felt, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 Return element of SEQUENCE at index N.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 (sequence, n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 CHECK_INT_COERCE_CHAR (n); /* yuck! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 if (LISTP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 Lisp_Object tem = Fnthcdr (n, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 /* #### Utterly, completely, fucking disgusting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 * #### The whole point of "elt" is that it operates on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 * #### sequences, and does error- (bounds-) checking.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 if (CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 return XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 #if 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 /* This is The Way It Has Always Been. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 /* This is The Way Mly and Cltl2 say It Should Be. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 args_out_of_range (sequence, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 else if (STRINGP (sequence) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 VECTORP (sequence) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 BIT_VECTORP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 return Faref (sequence, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 else if (COMPILED_FUNCTIONP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 EMACS_INT idx = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 if (idx < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 lose:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 args_out_of_range (sequence, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 /* Utter perversity */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 switch (idx)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 case COMPILED_ARGLIST:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 return compiled_function_arglist (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 case COMPILED_INSTRUCTIONS:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 return compiled_function_instructions (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 case COMPILED_CONSTANTS:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 return compiled_function_constants (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 case COMPILED_STACK_DEPTH:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 return compiled_function_stack_depth (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 case COMPILED_DOC_STRING:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 return compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 case COMPILED_DOMAIN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 return compiled_function_domain (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 case COMPILED_INTERACTIVE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 return compiled_function_interactive (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 /* if we return nil, can't tell interactive with no args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 from noninteractive. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 #endif /* LOSING_BYTECODE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 check_losing_bytecode ("elt", sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 sequence = wrong_type_argument (Qsequencep, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 DEFUN ("last", Flast, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 Return the tail of list LIST, of length N (default 1).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 LIST may be a dotted list, but not a circular list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 Optional argument N must be a non-negative integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 If N is zero, then the atom that terminates the list is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 If N is greater than the length of LIST, then LIST itself is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 (list, n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 EMACS_INT int_n, count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 Lisp_Object retval, tortoise, hare;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 CHECK_LIST (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 if (NILP (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 int_n = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 int_n = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 for (retval = tortoise = hare = list, count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 CONSP (hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 hare = XCDR (hare),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 (int_n-- <= 0 ? ((void) (retval = XCDR (retval))) : (void)0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 count++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 if (count & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 if (EQ (hare, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 signal_circular_list_error (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 Modify LIST to remove the last N (default 1) elements.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 If LIST has N or fewer elements, nil is returned and LIST is unmodified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 (list, n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 EMACS_INT int_n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 CHECK_LIST (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 if (NILP (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 int_n = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 int_n = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 Lisp_Object last_cons = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 EXTERNAL_LIST_LOOP_1 (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 if (int_n-- < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 last_cons = XCDR (last_cons);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 if (int_n >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 XCDR (last_cons) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 DEFUN ("butlast", Fbutlast, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 Return a copy of LIST with the last N (default 1) elements removed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 If LIST has N or fewer elements, nil is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 (list, n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1316 EMACS_INT int_n;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 CHECK_LIST (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 if (NILP (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 int_n = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 int_n = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 Lisp_Object retval = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 EXTERNAL_LIST_LOOP_1 (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 if (--int_n < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 retval = Fcons (XCAR (tail), retval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 return Fnreverse (retval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 DEFUN ("member", Fmember, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 if (internal_equal (elt, list_elt, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 DEFUN ("old-member", Fold_member, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 Do not use it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 if (internal_old_equal (elt, list_elt, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 DEFUN ("memq", Fmemq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 DEFUN ("old-memq", Fold_memq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 Do not use it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 if (HACKEQ_UNSAFE (elt, list_elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 memq_no_quit (Lisp_Object elt, Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 DEFUN ("assoc", Fassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1417 Return non-nil if KEY is `equal' to the car of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1418 The value is actually the element of ALIST whose car equals KEY.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1420 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 /* This function can GC. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1423 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 if (internal_equal (key, elt_car, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1432 Return non-nil if KEY is `old-equal' to the car of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1433 The value is actually the element of ALIST whose car equals KEY.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1435 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 /* This function can GC. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1438 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 if (internal_old_equal (key, elt_car, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1447 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 specbind (Qinhibit_quit, Qt);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1451 return unbind_to_1 (speccount, Fassoc (key, alist));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 DEFUN ("assq", Fassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1455 Return non-nil if KEY is `eq' to the car of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1456 The value is actually the element of ALIST whose car is KEY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1457 Elements of ALIST that are not conses are ignored.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1459 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1461 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1470 Return non-nil if KEY is `old-eq' to the car of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1471 The value is actually the element of ALIST whose car is KEY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1472 Elements of ALIST that are not conses are ignored.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 Do not use it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1476 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1478 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 if (HACKEQ_UNSAFE (key, elt_car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 /* Like Fassq but never report an error and do not allow quits.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 Use only on lists known never to be circular. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1490 assq_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 /* This cannot GC. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1493 LIST_LOOP_2 (elt, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 Lisp_Object elt_car = XCAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1503 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1504 The value is actually the element of ALIST whose cdr equals VALUE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1506 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1508 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1510 if (internal_equal (value, elt_cdr, 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1517 Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1518 The value is actually the element of ALIST whose cdr equals VALUE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1520 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1522 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1524 if (internal_old_equal (value, elt_cdr, 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 DEFUN ("rassq", Frassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1531 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1532 The value is actually the element of ALIST whose cdr is VALUE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1534 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1536 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1538 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1545 Return non-nil if VALUE is `old-eq' to the cdr of an element of ALIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1546 The value is actually the element of ALIST whose cdr is VALUE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1548 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1550 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1552 if (HACKEQ_UNSAFE (value, elt_cdr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1558 /* Like Frassq, but caller must ensure that ALIST is properly
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 nil-terminated and ebola-free. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1561 rassq_no_quit (Lisp_Object value, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1563 LIST_LOOP_2 (elt, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 Lisp_Object elt_cdr = XCDR (elt);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1566 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 DEFUN ("delete", Fdelete, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 Delete by side effect any occurrences of ELT as a member of LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 The modified LIST is returned. Comparison is done with `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 If the first member of LIST is ELT, there is no way to remove it by side
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 effect; therefore, write `(setq foo (delete element foo))' to be sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 of changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 Also see: `remove'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 (internal_equal (elt, list_elt, 0)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 DEFUN ("old-delete", Fold_delete, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 Delete by side effect any occurrences of ELT as a member of LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 The modified LIST is returned. Comparison is done with `old-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 If the first member of LIST is ELT, there is no way to remove it by side
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 effect; therefore, write `(setq foo (old-delete element foo))' to be sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 of changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 (internal_old_equal (elt, list_elt, 0)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 DEFUN ("delq", Fdelq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 Delete by side effect any occurrences of ELT as a member of LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 The modified LIST is returned. Comparison is done with `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 If the first member of LIST is ELT, there is no way to remove it by side
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 effect; therefore, write `(setq foo (delq element foo))' to be sure of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 DEFUN ("old-delq", Fold_delq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 Delete by side effect any occurrences of ELT as a member of LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 The modified LIST is returned. Comparison is done with `old-eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 If the first member of LIST is ELT, there is no way to remove it by side
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 effect; therefore, write `(setq foo (old-delq element foo))' to be sure of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 (HACKEQ_UNSAFE (elt, list_elt)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 /* Like Fdelq, but caller must ensure that LIST is properly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 nil-terminated and ebola-free. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 delq_no_quit (Lisp_Object elt, Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 /* Be VERY careful with this. This is like delq_no_quit() but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 also calls free_cons() on the removed conses. You must be SURE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 that no pointers to the freed conses remain around (e.g.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 someone else is pointing to part of the list). This function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 is useful on internal lists that are used frequently and where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 the actual list doesn't escape beyond known code bounds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 REGISTER Lisp_Object tem = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 if (EQ (elt, tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 Lisp_Object cons_to_free = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 list = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 XCDR (prev) = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 free_cons (XCONS (cons_to_free));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 DEFUN ("remassoc", Fremassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1677 Delete by side effect any elements of ALIST whose car is `equal' to KEY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1678 The modified ALIST is returned. If the first member of ALIST has a car
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 that is `equal' to KEY, there is no way to remove it by side effect;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 therefore, write `(setq foo (remassoc key foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1683 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1685 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 internal_equal (key, XCAR (elt), 0)));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1688 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1692 remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 specbind (Qinhibit_quit, Qt);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1696 return unbind_to_1 (speccount, Fremassoc (key, alist));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 DEFUN ("remassq", Fremassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1700 Delete by side effect any elements of ALIST whose car is `eq' to KEY.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1701 The modified ALIST is returned. If the first member of ALIST has a car
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 that is `eq' to KEY, there is no way to remove it by side effect;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 therefore, write `(setq foo (remassq key foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1706 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1708 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1711 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 /* no quit, no errors; be careful */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1717 remassq_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1719 LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1722 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1726 Delete by side effect any elements of ALIST whose cdr is `equal' to VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1727 The modified ALIST is returned. If the first member of ALIST has a car
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 that is `equal' to VALUE, there is no way to remove it by side effect;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 therefore, write `(setq foo (remrassoc value foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1732 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1734 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 internal_equal (value, XCDR (elt), 0)));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1737 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 DEFUN ("remrassq", Fremrassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1741 Delete by side effect any elements of ALIST whose cdr is `eq' to VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1742 The modified ALIST is returned. If the first member of ALIST has a car
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 that is `eq' to VALUE, there is no way to remove it by side effect;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 therefore, write `(setq foo (remrassq value foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1747 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1749 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1752 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 /* Like Fremrassq, fast and unsafe; be careful */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1757 remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1759 LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1762 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 Reverse LIST by destructively modifying cdr pointers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 Return the beginning of the reversed list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 Also see: `reverse'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 /* We gcpro our args; see `nconc' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 GCPRO2 (prev, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 REGISTER Lisp_Object next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 CONCHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 next = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 XCDR (tail) = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 tail = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 return prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 DEFUN ("reverse", Freverse, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 Reverse LIST, copying. Return the beginning of the reversed list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 See also the function `nreverse', which is used more often.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 Lisp_Object reversed_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 EXTERNAL_LIST_LOOP_2 (elt, list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 reversed_list = Fcons (elt, reversed_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 return reversed_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 Lisp_Object lisp_arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 int (*pred_fn) (Lisp_Object, Lisp_Object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 Lisp_Object lisp_arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 list_sort (Lisp_Object list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 Lisp_Object lisp_arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 int (*pred_fn) (Lisp_Object, Lisp_Object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 Lisp_Object lisp_arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 Lisp_Object back, tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 Lisp_Object front = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 Lisp_Object len = Flength (list);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1820
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1821 if (XINT (len) < 2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1824 len = make_int (XINT (len) / 2 - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 tem = Fnthcdr (len, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 back = Fcdr (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 Fsetcdr (tem, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 GCPRO3 (front, back, lisp_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 front = list_sort (front, lisp_arg, pred_fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 back = list_sort (back, lisp_arg, pred_fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 return list_merge (front, back, lisp_arg, pred_fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 merge_pred_function (Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 Lisp_Object pred)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 Lisp_Object tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 /* prevents the GC from happening in call2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 /* Emacs' GC doesn't actually relocate pointers, so this probably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 isn't strictly necessary */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1846 int speccount = begin_gc_forbidden ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 tmp = call2 (pred, obj1, obj2);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
1848 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 if (NILP (tmp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 DEFUN ("sort", Fsort, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 Sort LIST, stably, comparing elements using PREDICATE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 Returns the sorted list. LIST is modified by side effects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 PREDICATE is called with two elements of LIST, and should return T
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 if the first element is "less" than the second.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1862 (list, predicate))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1864 return list_sort (list, predicate, merge_pred_function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 merge (Lisp_Object org_l1, Lisp_Object org_l2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 Lisp_Object pred)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 return list_merge (org_l1, org_l2, pred, merge_pred_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 Lisp_Object lisp_arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 int (*pred_fn) (Lisp_Object, Lisp_Object, Lisp_Object lisp_arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 Lisp_Object value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 Lisp_Object l1, l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 l1 = org_l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 l2 = org_l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 value = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 /* It is sufficient to protect org_l1 and org_l2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 When l1 and l2 are updated, we copy the new values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 back into the org_ vars. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 GCPRO4 (org_l1, org_l2, lisp_arg, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 if (NILP (l1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 return l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 Fsetcdr (tail, l2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 if (NILP (l2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 return l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 Fsetcdr (tail, l1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 if (((*pred_fn) (Fcar (l2), Fcar (l1), lisp_arg)) < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 tem = l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 l1 = Fcdr (l1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 org_l1 = l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 tem = l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 l2 = Fcdr (l2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 org_l2 = l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 value = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 Fsetcdr (tail, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 tail = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 /* property-list functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 /* For properties of text, we need to do order-insensitive comparison of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 plists. That is, we need to compare two plists such that they are the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 same if they have the same set of keys, and equivalent values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 So (a 1 b 2) would be equal to (b 2 a 1).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 NIL_MEANS_NOT_PRESENT is as in `plists-eq' etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 LAXP means use `equal' for comparisons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 int laxp, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
1953 int eqp = (depth == -1); /* -1 as depth means use eq, not equal. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 int la, lb, m, i, fill;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 Lisp_Object *keys, *vals;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 char *flags;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 if (NILP (a) && NILP (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 Fcheck_valid_plist (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 Fcheck_valid_plist (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 la = XINT (Flength (a));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 lb = XINT (Flength (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 m = (la > lb ? la : lb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 fill = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 keys = alloca_array (Lisp_Object, m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 vals = alloca_array (Lisp_Object, m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 flags = alloca_array (char, m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 /* First extract the pairs from A. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 for (rest = a; !NILP (rest); rest = XCDR (XCDR (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 Lisp_Object k = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 Lisp_Object v = XCAR (XCDR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 /* Maybe be Ebolified. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 if (nil_means_not_present && NILP (v)) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 keys [fill] = k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 vals [fill] = v;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 flags[fill] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 fill++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 /* Now iterate over B, and stop if we find something that's not in A,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 or that doesn't match. As we match, mark them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 for (rest = b; !NILP (rest); rest = XCDR (XCDR (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 Lisp_Object k = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 Lisp_Object v = XCAR (XCDR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 /* Maybe be Ebolified. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 if (nil_means_not_present && NILP (v)) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 for (i = 0; i < fill; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1997 if (eqp
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1998 /* We narrowly escaped being Ebolified here. */
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1999 ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2000 : !internal_equal (v, vals [i], depth))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 /* a property in B has a different value than in A */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 goto MISMATCH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 flags [i] = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 if (i == fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 /* there are some properties in B that are not in A */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 goto MISMATCH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 /* Now check to see that all the properties in A were also in B */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 for (i = 0; i < fill; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 if (flags [i] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 goto MISMATCH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 /* Ok. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 MISMATCH:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 DEFUN ("plists-eq", Fplists_eq, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 Return non-nil if property lists A and B are `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 A property list is an alternating list of keywords and values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 This function does order-insensitive comparisons of the property lists:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 Comparison between values is done using `eq'. See also `plists-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 a nil value is ignored. This feature is a virus that has infected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 (a, b, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 DEFUN ("plists-equal", Fplists_equal, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 Return non-nil if property lists A and B are `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 A property list is an alternating list of keywords and values. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 function does order-insensitive comparisons of the property lists: For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 Comparison between values is done using `equal'. See also `plists-eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 a nil value is ignored. This feature is a virus that has infected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 (a, b, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 DEFUN ("lax-plists-eq", Flax_plists_eq, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 Return non-nil if lax property lists A and B are `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 A property list is an alternating list of keywords and values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 This function does order-insensitive comparisons of the property lists:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 Comparison between values is done using `eq'. See also `plists-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 A lax property list is like a regular one except that comparisons between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 keywords is done using `equal' instead of `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 a nil value is ignored. This feature is a virus that has infected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 (a, b, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 DEFUN ("lax-plists-equal", Flax_plists_equal, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 Return non-nil if lax property lists A and B are `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 A property list is an alternating list of keywords and values. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 function does order-insensitive comparisons of the property lists: For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 Comparison between values is done using `equal'. See also `plists-eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 A lax property list is like a regular one except that comparisons between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 keywords is done using `equal' instead of `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 a nil value is ignored. This feature is a virus that has infected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 (a, b, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 /* Return the value associated with key PROPERTY in property list PLIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 Return nil if key not found. This function is used for internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 property lists that cannot be directly manipulated by the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 internal_plist_get (Lisp_Object plist, Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 for (tail = plist; !NILP (tail); tail = XCDR (XCDR (tail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 if (EQ (XCAR (tail), property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 return XCAR (XCDR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 /* Set PLIST's value for PROPERTY to VALUE. Analogous to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 internal_plist_get(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 internal_plist_put (Lisp_Object *plist, Lisp_Object property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 for (tail = *plist; !NILP (tail); tail = XCDR (XCDR (tail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 if (EQ (XCAR (tail), property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 XCAR (XCDR (tail)) = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 *plist = Fcons (property, Fcons (value, *plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 internal_remprop (Lisp_Object *plist, Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 Lisp_Object tail, prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 for (tail = *plist, prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 !NILP (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 tail = XCDR (XCDR (tail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 if (EQ (XCAR (tail), property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 *plist = XCDR (XCDR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 XCDR (XCDR (prev)) = XCDR (XCDR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 /* Called on a malformed property list. BADPLACE should be some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 place where truncating will form a good list -- i.e. we shouldn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 result in a list with an odd length. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 static Lisp_Object
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2165 bad_bad_bunny (Lisp_Object *plist, Lisp_Object *badplace, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 if (ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 return Fsignal (Qmalformed_property_list, list2 (*plist, *badplace));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 if (ERRB_EQ (errb, ERROR_ME_WARN))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 warn_when_safe_lispobj
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 (Qlist, Qwarning,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
2175 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 ("Malformed property list -- list has been truncated"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 *plist));
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2178 /* #### WARNING: This is more dangerous than it seems; perhaps
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2179 not a good idea. It also violates the principle of least
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2180 surprise -- passing in ERROR_ME_WARN causes truncation, but
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2181 ERROR_ME and ERROR_ME_NOT don't. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 *badplace = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 /* Called on a circular property list. BADPLACE should be some place
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 where truncating will result in an even-length list, as above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 If doesn't particularly matter where we truncate -- anywhere we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 truncate along the entire list will break the circularity, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 it will create a terminus and the list currently doesn't have one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 static Lisp_Object
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2196 bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 if (ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 return Fsignal (Qcircular_property_list, list1 (*plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 if (ERRB_EQ (errb, ERROR_ME_WARN))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 warn_when_safe_lispobj
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 (Qlist, Qwarning,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
2206 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 ("Circular property list -- list has been truncated"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 *plist));
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2209 /* #### WARNING: This is more dangerous than it seems; perhaps
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2210 not a good idea. It also violates the principle of least
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2211 surprise -- passing in ERROR_ME_WARN causes truncation, but
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2212 ERROR_ME and ERROR_ME_NOT don't. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 *badplace = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 /* Advance the tortoise pointer by two (one iteration of a property-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 loop) and the hare pointer by four and verify that no malformations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 or circularities exist. If so, return zero and store a value into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 RETVAL that should be returned by the calling function. Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 return 1. See external_plist_get().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 advance_plist_pointers (Lisp_Object *plist,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 Lisp_Object **tortoise, Lisp_Object **hare,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2229 Error_Behavior errb, Lisp_Object *retval)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 Lisp_Object *tortsave = *tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 /* Note that our "fixing" may be more brutal than necessary,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 but it's the user's own problem, not ours, if they went in and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 manually fucked up a plist. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 for (i = 0; i < 2; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 /* This is a standard iteration of a defensive-loop-checking
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 loop. We just do it twice because we want to advance past
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 both the property and its value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 If the pointer indirection is confusing you, remember that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 one level of indirection on the hare and tortoise pointers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 is only due to pass-by-reference for this function. The other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 level is so that the plist can be fixed in place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 /* When we reach the end of a well-formed plist, **HARE is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 nil. In that case, we don't do anything at all except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 advance TORTOISE by one. Otherwise, we advance HARE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 by two (making sure it's OK to do so), then advance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 TORTOISE by one (it will always be OK to do so because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 the HARE is always ahead of the TORTOISE and will have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 already verified the path), then make sure TORTOISE and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 HARE don't contain the same non-nil object -- if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 TORTOISE and the HARE ever meet, then obviously we're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 in a circularity, and if we're in a circularity, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 the TORTOISE and the HARE can't cross paths without
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 meeting, since the HARE only gains one step over the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 TORTOISE per iteration. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 if (!NILP (**hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 Lisp_Object *haresave = *hare;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 if (!CONSP (**hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 *retval = bad_bad_bunny (plist, haresave, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 *hare = &XCDR (**hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 /* In a non-plist, we'd check here for a nil value for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 **HARE, which is OK (it just means the list has an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 odd number of elements). In a plist, it's not OK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 for the list to have an odd number of elements. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 if (!CONSP (**hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 *retval = bad_bad_bunny (plist, haresave, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 *hare = &XCDR (**hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 *tortoise = &XCDR (**tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 if (!NILP (**hare) && EQ (**tortoise, **hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 *retval = bad_bad_turtle (plist, tortsave, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 /* Return the value of PROPERTY from PLIST, or Qunbound if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 property is not on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 PLIST is a Lisp-accessible property list, meaning that it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 has to be checked for malformations and circularities.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 If ERRB is ERROR_ME, an error will be signalled. Otherwise, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 function will never signal an error; and if ERRB is ERROR_ME_WARN,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 on finding a malformation or a circularity, it issues a warning and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 attempts to silently fix the problem.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 A pointer to PLIST is passed in so that PLIST can be successfully
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 "fixed" even if the error is at the beginning of the plist. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 external_plist_get (Lisp_Object *plist, Lisp_Object property,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2311 int laxp, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 Lisp_Object *tortoise = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 Lisp_Object *hare = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 Lisp_Object *tortsave = tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 /* We do the standard tortoise/hare march. We isolate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 grungy stuff to do this in advance_plist_pointers(), though.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 To us, all this function does is advance the tortoise
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 pointer by two and the hare pointer by four and make sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 everything's OK. We first advance the pointers and then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 check if a property matched; this ensures that our
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 check for a matching property is safe. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 if (!laxp ? EQ (XCAR (*tortsave), property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 : internal_equal (XCAR (*tortsave), property, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 return XCAR (XCDR (*tortsave));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 /* Set PLIST's value for PROPERTY to VALUE, given a possibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 malformed or circular plist. Analogous to external_plist_get(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 external_plist_put (Lisp_Object *plist, Lisp_Object property,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2345 Lisp_Object value, int laxp, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 Lisp_Object *tortoise = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 Lisp_Object *hare = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 Lisp_Object *tortsave = tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 if (!laxp ? EQ (XCAR (*tortsave), property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 : internal_equal (XCAR (*tortsave), property, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 XCAR (XCDR (*tortsave)) = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 *plist = Fcons (property, Fcons (value, *plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 external_remprop (Lisp_Object *plist, Lisp_Object property,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2372 int laxp, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 Lisp_Object *tortoise = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 Lisp_Object *hare = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 Lisp_Object *tortsave = tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 if (!laxp ? EQ (XCAR (*tortsave), property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 : internal_equal (XCAR (*tortsave), property, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 /* Now you see why it's so convenient to have that level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 of indirection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 *tortsave = XCDR (XCDR (*tortsave));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 DEFUN ("plist-get", Fplist_get, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 Extract a value from a property list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 PLIST is a property list, which is a list of the form
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2402 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...).
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2403 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2404 This function returns the value corresponding to the PROPERTY,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2405 or DEFAULT if PROPERTY is not one of the properties on the list.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2407 (plist, property, default_))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2409 Lisp_Object value = external_plist_get (&plist, property, 0, ERROR_ME);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2410 return UNBOUNDP (value) ? default_ : value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 DEFUN ("plist-put", Fplist_put, 3, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2414 Change value in PLIST of PROPERTY to VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2415 PLIST is a property list, which is a list of the form
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2416 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...).
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2417 PROPERTY is usually a symbol and VALUE is any object.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2418 If PROPERTY is already a property on the list, its value is set to VALUE,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2419 otherwise the new PROPERTY VALUE pair is added.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2420 The new plist is returned; use `(setq x (plist-put x property value))'
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2421 to be sure to use the new value. PLIST is modified by side effect.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2423 (plist, property, value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2425 external_plist_put (&plist, property, value, 0, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 return plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2430 Remove from PLIST the property PROPERTY and its value.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2431 PLIST is a property list, which is a list of the form
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2432 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...).
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2433 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2434 The new plist is returned; use `(setq x (plist-remprop x property))'
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2435 to be sure to use the new value. PLIST is modified by side effect.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2437 (plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2439 external_remprop (&plist, property, 0, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 return plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 DEFUN ("plist-member", Fplist_member, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2444 Return t if PROPERTY has a value specified in PLIST.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2446 (plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2448 Lisp_Object value = Fplist_get (plist, property, Qunbound);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2449 return UNBOUNDP (value) ? Qnil : Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 Given a plist, signal an error if there is anything wrong with it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 This means that it's a malformed or circular plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 (plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 Lisp_Object *tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 Lisp_Object *hare;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 start_over:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 tortoise = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 hare = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 goto start_over;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 Given a plist, return non-nil if its format is correct.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 If it returns nil, `check-valid-plist' will signal an error when given
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2480 the plist; that means it's a malformed or circular plist.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 (plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 Lisp_Object *tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 Lisp_Object *hare;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 tortoise = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 hare = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME_NOT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 DEFUN ("canonicalize-plist", Fcanonicalize_plist, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 Destructively remove any duplicate entries from a plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 In such cases, the first entry applies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 a nil value is removed. This feature is a virus that has infected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 return value may not be EQ to the passed-in value, so make sure to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 `setq' the value back into where it came from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 (plist, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 Lisp_Object head = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 Fcheck_valid_plist (plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 while (!NILP (plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 Lisp_Object prop = Fcar (plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 Lisp_Object next = Fcdr (plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 CHECK_CONS (next); /* just make doubly sure we catch any errors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 if (!NILP (nil_means_not_present) && NILP (Fcar (next)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 if (EQ (head, plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 head = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 plist = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 /* external_remprop returns 1 if it removed any property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 We have to loop till it didn't remove anything, in case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 the property occurs many times. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 while (external_remprop (&XCDR (next), prop, 0, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 DO_NOTHING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 plist = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 return head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 Extract a value from a lax property list.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2547 LAX-PLIST is a lax property list, which is a list of the form
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2548 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2549 properties is done using `equal' instead of `eq'.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2550 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2551 This function returns the value corresponding to PROPERTY,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2552 or DEFAULT if PROPERTY is not one of the properties on the list.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2554 (lax_plist, property, default_))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2556 Lisp_Object value = external_plist_get (&lax_plist, property, 1, ERROR_ME);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2557 return UNBOUNDP (value) ? default_ : value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2561 Change value in LAX-PLIST of PROPERTY to VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2562 LAX-PLIST is a lax property list, which is a list of the form
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2563 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2564 properties is done using `equal' instead of `eq'.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2565 PROPERTY is usually a symbol and VALUE is any object.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2566 If PROPERTY is already a property on the list, its value is set to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2567 VALUE, otherwise the new PROPERTY VALUE pair is added.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2568 The new plist is returned; use `(setq x (lax-plist-put x property value))'
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2569 to be sure to use the new value. LAX-PLIST is modified by side effect.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2571 (lax_plist, property, value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2573 external_plist_put (&lax_plist, property, value, 1, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 return lax_plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2578 Remove from LAX-PLIST the property PROPERTY and its value.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2579 LAX-PLIST is a lax property list, which is a list of the form
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2580 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2581 properties is done using `equal' instead of `eq'.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2582 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2583 The new plist is returned; use `(setq x (lax-plist-remprop x property))'
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2584 to be sure to use the new value. LAX-PLIST is modified by side effect.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2586 (lax_plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2588 external_remprop (&lax_plist, property, 1, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 return lax_plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2593 Return t if PROPERTY has a value specified in LAX-PLIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2594 LAX-PLIST is a lax property list, which is a list of the form
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2595 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2596 properties is done using `equal' instead of `eq'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2598 (lax_plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2600 return UNBOUNDP (Flax_plist_get (lax_plist, property, Qunbound)) ? Qnil : Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 Destructively remove any duplicate entries from a lax plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 In such cases, the first entry applies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 a nil value is removed. This feature is a virus that has infected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 return value may not be EQ to the passed-in value, so make sure to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 `setq' the value back into where it came from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 (lax_plist, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 Lisp_Object head = lax_plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 Fcheck_valid_plist (lax_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 while (!NILP (lax_plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 Lisp_Object prop = Fcar (lax_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 Lisp_Object next = Fcdr (lax_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 CHECK_CONS (next); /* just make doubly sure we catch any errors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 if (!NILP (nil_means_not_present) && NILP (Fcar (next)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 if (EQ (head, lax_plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 head = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 lax_plist = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 /* external_remprop returns 1 if it removed any property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 We have to loop till it didn't remove anything, in case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 the property occurs many times. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 while (external_remprop (&XCDR (next), prop, 1, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 DO_NOTHING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 lax_plist = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 return head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 /* In C because the frame props stuff uses it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 DEFUN ("destructive-alist-to-plist", Fdestructive_alist_to_plist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 Convert association list ALIST into the equivalent property-list form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 The plist is returned. This converts from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 \((a . 1) (b . 2) (c . 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 \(a 1 b 2 c 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 The original alist is destroyed in the process of constructing the plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 See also `alist-to-plist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 (alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 Lisp_Object head = alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 while (!NILP (alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 /* remember the alist element. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 Lisp_Object el = Fcar (alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 Fsetcar (alist, Fcar (el));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 Fsetcar (el, Fcdr (el));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 Fsetcdr (el, Fcdr (alist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 Fsetcdr (alist, el);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 alist = Fcdr (Fcdr (alist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 return head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 DEFUN ("get", Fget, 2, 3, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2680 Return the value of OBJECT's PROPERTY property.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2681 This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 If there is no such property, return optional third arg DEFAULT
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2683 \(which defaults to `nil'). OBJECT can be a symbol, string, extent,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2684 face, or glyph. See also `put', `remprop', and `object-plist'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2686 (object, property, default_))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 /* Various places in emacs call Fget() and expect it not to quit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 so don't quit. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2690 Lisp_Object val;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2691
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2692 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->getprop)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2693 val = XRECORD_LHEADER_IMPLEMENTATION (object)->getprop (object, property);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2695 invalid_operation ("Object type has no properties", object);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2696
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2697 return UNBOUNDP (val) ? default_ : val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 DEFUN ("put", Fput, 3, 3, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2701 Set OBJECT's PROPERTY to VALUE.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2702 It can be subsequently retrieved with `(get OBJECT PROPERTY)'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2703 OBJECT can be a symbol, face, extent, or string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 For a string, no properties currently have predefined meanings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 For the predefined properties for extents, see `set-extent-property'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 For the predefined properties for faces, see `set-face-property'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 See also `get', `remprop', and `object-plist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2709 (object, property, value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 CHECK_LISP_WRITEABLE (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2713 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->putprop)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2715 if (! XRECORD_LHEADER_IMPLEMENTATION (object)->putprop
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2716 (object, property, value))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2717 invalid_change ("Can't set property on object", property);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2720 invalid_change ("Object type has no settable properties", object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 DEFUN ("remprop", Fremprop, 2, 2, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2726 Remove, from OBJECT's property list, PROPERTY and its corresponding value.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2727 OBJECT can be a symbol, string, extent, face, or glyph. Return non-nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2728 if the property list was actually modified (i.e. if PROPERTY was present
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2729 in the property list). See also `get', `put', and `object-plist'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2731 (object, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2733 int ret = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2734
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 CHECK_LISP_WRITEABLE (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2737 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->remprop)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2739 ret = XRECORD_LHEADER_IMPLEMENTATION (object)->remprop (object, property);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2740 if (ret == -1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2741 invalid_change ("Can't remove property from object", property);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2744 invalid_change ("Object type has no removable properties", object);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2745
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2746 return ret ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2750 Return a property list of OBJECT's properties.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2751 For a symbol, this is equivalent to `symbol-plist'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2752 OBJECT can be a symbol, string, extent, face, or glyph.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2753 Do not modify the returned property list directly;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2754 this may or may not have the desired effects. Use `put' instead.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2758 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->plist)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2759 return XRECORD_LHEADER_IMPLEMENTATION (object)->plist (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2761 invalid_operation ("Object type has no properties", object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 internal_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 if (depth > 200)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2771 stack_overflow ("Stack overflow in equal", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 /* Note that (equal 20 20.0) should be nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 if (XTYPE (obj1) != XTYPE (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 if (LRECORDP (obj1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2780 const struct lrecord_implementation
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 return (imp1 == imp2) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 /* EQ-ness of the objects was noticed above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 (imp1->equal && (imp1->equal) (obj1, obj2, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2792 int
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2793 internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2794 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2795 if (depth > 200)
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2796 stack_overflow ("Stack overflow in equalp", Qunbound);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2797 QUIT;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2798 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2799 return 1;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2800 if ((INTP (obj1) && FLOATP (obj2)) || (FLOATP (obj1) && INTP (obj2)))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2801 return extract_float (obj1) == extract_float (obj2);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2802 if (CHARP (obj1) && CHARP (obj2))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2803 return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2));
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2804 if (XTYPE (obj1) != XTYPE (obj2))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2805 return 0;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2806 if (LRECORDP (obj1))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2807 {
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2808 const struct lrecord_implementation
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2809 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2810 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2811
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2812 /* #### not yet implemented properly, needs another flag to specify
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2813 equalp-ness */
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2814 return (imp1 == imp2) &&
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2815 /* EQ-ness of the objects was noticed above */
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2816 (imp1->equal && (imp1->equal) (obj1, obj2, depth));
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2817 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2818
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2819 return 0;
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2820 }
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2821
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 /* Note that we may be calling sub-objects that will use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 internal_equal() (instead of internal_old_equal()). Oh well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 We will get an Ebola note if there's any possibility of confusion,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 but that seems unlikely. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 if (depth > 200)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2831 stack_overflow ("Stack overflow in equal", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 if (HACKEQ_UNSAFE (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 /* Note that (equal 20 20.0) should be nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 if (XTYPE (obj1) != XTYPE (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 return internal_equal (obj1, obj2, depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 DEFUN ("equal", Fequal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 Return t if two Lisp objects have similar structure and contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 They must have the same data type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 Conses are compared by comparing the cars and the cdrs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 Vectors and strings are compared element by element.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 Numbers are compared by value. Symbols must match exactly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2849 (object1, object2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2851 return internal_equal (object1, object2, 0) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 DEFUN ("old-equal", Fold_equal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 Return t if two Lisp objects have similar structure and contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 They must have the same data type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 \(Note, however, that an exception is made for characters and integers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 this is known as the "char-int confoundance disease." See `eq' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 `old-eq'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 Do not use it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2863 (object1, object2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2865 return internal_old_equal (object1, object2, 0) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 DEFUN ("fillarray", Ffillarray, 2, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2870 Destructively modify ARRAY by replacing each element with ITEM.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 ARRAY is a vector, bit vector, or string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 (array, item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 if (STRINGP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2878 Bytecount old_bytecount = XSTRING_LENGTH (array);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2879 Bytecount new_bytecount;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2880 Bytecount item_bytecount;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2881 Intbyte item_buf[MAX_EMCHAR_LEN];
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2882 Intbyte *p;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2883 Intbyte *end;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2884
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 CHECK_CHAR_COERCE_INT (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 CHECK_LISP_WRITEABLE (array);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2887
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
2888 sledgehammer_check_ascii_begin (array);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2889 item_bytecount = set_charptr_emchar (item_buf, XCHAR (item));
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2890 new_bytecount = item_bytecount * (Bytecount) XSTRING_CHAR_LENGTH (array);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2891
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2892 resize_string (array, -1, new_bytecount - old_bytecount);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2893
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2894 for (p = XSTRING_DATA (array), end = p + new_bytecount;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2895 p < end;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2896 p += item_bytecount)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2897 memcpy (p, item_buf, item_bytecount);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2898 *p = '\0';
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2899
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2900 XSET_STRING_ASCII_BEGIN (array,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2901 item_bytecount == 1 ?
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2902 min (new_bytecount, MAX_STRING_ASCII_BEGIN) :
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
2903 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 bump_string_modiff (array);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
2905 sledgehammer_check_ascii_begin (array);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 else if (VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 Lisp_Object *p = XVECTOR_DATA (array);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2910 Elemcount len = XVECTOR_LENGTH (array);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 CHECK_LISP_WRITEABLE (array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 while (len--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 *p++ = item;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 else if (BIT_VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2917 Lisp_Bit_Vector *v = XBIT_VECTOR (array);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2918 Elemcount len = bit_vector_length (v);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 int bit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 CHECK_BIT (item);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2921 bit = XINT (item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 CHECK_LISP_WRITEABLE (array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 while (len--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 set_bit_vector_bit (v, len, bit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 array = wrong_type_argument (Qarrayp, array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 return array;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 nconc2 (Lisp_Object arg1, Lisp_Object arg2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 Lisp_Object args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 args[0] = arg1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 args[1] = arg2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 GCPRO1 (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 gcpro1.nvars = 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 RETURN_UNGCPRO (bytecode_nconc2 (args));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 bytecode_nconc2 (Lisp_Object *args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 if (CONSP (args[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 /* (setcdr (last args[0]) args[1]) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 Lisp_Object tortoise, hare;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2957 Elemcount count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 for (hare = tortoise = args[0], count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 CONSP (XCDR (hare));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 hare = XCDR (hare), count++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 if (count & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 if (EQ (hare, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 signal_circular_list_error (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 XCDR (hare) = args[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 return args[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 else if (NILP (args[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 return args[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 args[0] = wrong_type_argument (args[0], Qlistp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 DEFUN ("nconc", Fnconc, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 Concatenate any number of lists by altering them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 Only the last argument is not altered, and need not be a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 Also see: `append'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 If the first argument is nil, there is no way to modify it by side
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 effect; therefore, write `(setq foo (nconc foo list))' to be sure of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 int argnum = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 /* The modus operandi in Emacs is "caller gc-protects args".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 However, nconc (particularly nconc2 ()) is called many times
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 in Emacs on freshly created stuff (e.g. you see the idiom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 nconc2 (Fcopy_sequence (foo), bar) a lot). So we help those
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 callers out by protecting the args ourselves to save them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 a lot of temporary-variable grief. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 GCPRO1 (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 gcpro1.nvars = nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 while (argnum < nargs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 val = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 if (CONSP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 /* `val' is the first cons, which will be our return value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 /* `last_cons' will be the cons cell to mutate. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 Lisp_Object last_cons = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 Lisp_Object tortoise = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 for (argnum++; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 Lisp_Object next = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 retry_next:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 if (CONSP (next) || argnum == nargs -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 /* (setcdr (last val) next) */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3026 Elemcount count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 for (count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 CONSP (XCDR (last_cons));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 last_cons = XCDR (last_cons), count++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 if (count & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 if (EQ (last_cons, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 signal_circular_list_error (args[argnum-1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 XCDR (last_cons) = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 else if (NILP (next))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 next = wrong_type_argument (Qlistp, next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 goto retry_next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 RETURN_UNGCPRO (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 else if (NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 argnum++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 else if (argnum == nargs - 1) /* last arg? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 RETURN_UNGCPRO (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 args[argnum] = wrong_type_argument (Qlistp, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3067 /* This is the guts of several mapping functions.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3068 Apply FUNCTION to each element of SEQUENCE, one by one,
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3069 storing the results into elements of VALS, a C vector of Lisp_Objects.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3070 LENI is the length of VALS, which should also be the length of SEQUENCE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 If VALS is a null pointer, do not accumulate the results. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 static void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3075 mapcar1 (Elemcount leni, Lisp_Object *vals,
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3076 Lisp_Object function, Lisp_Object sequence)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 Lisp_Object args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 if (vals)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 GCPRO1 (vals[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 gcpro1.nvars = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3088 args[0] = function;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3089
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3090 if (LISTP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3092 /* A devious `function' could either:
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3093 - insert garbage into the list in front of us, causing XCDR to crash
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3094 - amputate the list behind us using (setcdr), causing the remaining
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3095 elts to lose their GCPRO status.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3096
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3097 if (vals != 0) we avoid this by copying the elts into the
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3098 `vals' array. By a stroke of luck, `vals' is exactly large
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3099 enough to hold the elts left to be traversed as well as the
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3100 results computed so far.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3101
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3102 if (vals == 0) we don't have any free space available and
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3103 don't want to eat up any more stack with alloca().
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3104 So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3105
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3106 if (vals)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3108 Lisp_Object *val = vals;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3109 Elemcount i;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3110
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3111 LIST_LOOP_2 (elt, sequence)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3112 *val++ = elt;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3113
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3114 gcpro1.nvars = leni;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3115
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3116 for (i = 0; i < leni; i++)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3117 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3118 args[1] = vals[i];
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3119 vals[i] = Ffuncall (2, args);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3120 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3121 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3122 else
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3123 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3124 Lisp_Object elt, tail;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3125 EMACS_INT len_unused;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3126 struct gcpro ngcpro1;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3127
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3128 NGCPRO1 (tail);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3129
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3130 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3131 EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len_unused)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3132 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3133 args[1] = elt;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3134 Ffuncall (2, args);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3135 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3136 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3137
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3138 NUNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3141 else if (VECTORP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3143 Lisp_Object *objs = XVECTOR_DATA (sequence);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3144 Elemcount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 for (i = 0; i < leni; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 args[1] = *objs++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 result = Ffuncall (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 if (vals) vals[gcpro1.nvars++] = result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3152 else if (STRINGP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3154 /* The string data of `sequence' might be relocated during GC. */
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3155 Bytecount slen = XSTRING_LENGTH (sequence);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3156 Intbyte *p = alloca_array (Intbyte, slen);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3157 Intbyte *end = p + slen;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3158
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3159 memcpy (p, XSTRING_DATA (sequence), slen);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3160
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3161 while (p < end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 args[1] = make_char (charptr_emchar (p));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 INC_CHARPTR (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 result = Ffuncall (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 if (vals) vals[gcpro1.nvars++] = result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3169 else if (BIT_VECTORP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3171 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3172 Elemcount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 for (i = 0; i < leni; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 args[1] = make_int (bit_vector_bit (v, i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 result = Ffuncall (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 if (vals) vals[gcpro1.nvars++] = result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3181 abort (); /* unreachable, since Flength (sequence) did not get an error */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 if (vals)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
751
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 665
diff changeset
3188 Apply FUNCTION to each element of SEQUENCE, and concat the results to a string.
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 665
diff changeset
3189 Between each pair of results, insert SEPARATOR.
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 665
diff changeset
3190
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 665
diff changeset
3191 Each result, and SEPARATOR, should be strings. Thus, using " " as SEPARATOR
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 665
diff changeset
3192 results in spaces between the values returned by FUNCTION. SEQUENCE itself
358bd84dc7ff [xemacs-hg @ 2002-02-13 12:55:38 by stephent]
stephent
parents: 665
diff changeset
3193 may be a list, a vector, a bit vector, or a string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3195 (function, sequence, separator))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3197 EMACS_INT len = XINT (Flength (sequence));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 Lisp_Object *args;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3199 EMACS_INT i;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3200 EMACS_INT nargs = len + len - 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3202 if (len == 0) return build_string ("");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 args = alloca_array (Lisp_Object, nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3206 mapcar1 (len, args, function, sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 for (i = len - 1; i >= 0; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 args[i + i] = args[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 for (i = 1; i < nargs; i += 2)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3212 args[i] = separator;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 return Fconcat (nargs, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 DEFUN ("mapcar", Fmapcar, 2, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3218 Apply FUNCTION to each element of SEQUENCE; return a list of the results.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3219 The result is a list of the same length as SEQUENCE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 SEQUENCE may be a list, a vector, a bit vector, or a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3222 (function, sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3224 Elemcount len = XINT (Flength (sequence));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 Lisp_Object *args = alloca_array (Lisp_Object, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3227 mapcar1 (len, args, function, sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
3229 return Flist ((int) len, args);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 DEFUN ("mapvector", Fmapvector, 2, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3233 Apply FUNCTION to each element of SEQUENCE; return a vector of the results.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 The result is a vector of the same length as SEQUENCE.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3235 SEQUENCE may be a list, a vector, a bit vector, or a string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3237 (function, sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3239 Elemcount len = XINT (Flength (sequence));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 Lisp_Object result = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 GCPRO1 (result);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3244 mapcar1 (len, XVECTOR_DATA (result), function, sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 Apply FUNCTION to each element of SEQUENCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 SEQUENCE may be a list, a vector, a bit vector, or a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 This function is like `mapcar' but does not accumulate the results,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 which is more efficient if you do not use the results.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 The difference between this and `mapc' is that `mapc' supports all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 the spiffy Common Lisp arguments. You should normally use `mapc'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3259 (function, sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3261 mapcar1 (XINT (Flength (sequence)), 0, function, sequence);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3262
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3263 return sequence;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3267 /* Extra random functions */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3268
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3269 DEFUN ("replace-list", Freplace_list, 2, 2, 0, /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3270 Destructively replace the list OLD with NEW.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3271 This is like (copy-sequence NEW) except that it reuses the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3272 conses in OLD as much as possible. If OLD and NEW are the same
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3273 length, no consing will take place.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3274 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3275 (old, new))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3276 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3277 Lisp_Object tail, oldtail = old, prevoldtail = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3278
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3279 EXTERNAL_LIST_LOOP (tail, new)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3280 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3281 if (!NILP (oldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3282 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3283 CHECK_CONS (oldtail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3284 XCAR (oldtail) = XCAR (tail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3285 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3286 else if (!NILP (prevoldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3287 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3288 XCDR (prevoldtail) = Fcons (XCAR (tail), Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3289 prevoldtail = XCDR (prevoldtail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3290 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3291 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3292 old = oldtail = Fcons (XCAR (tail), Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3293
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3294 if (!NILP (oldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3295 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3296 prevoldtail = oldtail;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3297 oldtail = XCDR (oldtail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3298 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3299 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3300
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3301 if (!NILP (prevoldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3302 XCDR (prevoldtail) = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3303 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3304 old = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3305
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3306 return old;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3307 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3308
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3309 Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3310 add_suffix_to_symbol (Lisp_Object symbol, const Char_ASCII *ascii_string)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3311 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3312 return Fintern (concat2 (Fsymbol_name (symbol),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3313 build_string (ascii_string)),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3314 Qnil);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3315 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3316
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3317 Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3318 add_prefix_to_symbol (const Char_ASCII *ascii_string, Lisp_Object symbol)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3319 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3320 return Fintern (concat2 (build_string (ascii_string),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3321 Fsymbol_name (symbol)),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3322 Qnil);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3323 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3324
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3325
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 /* #### this function doesn't belong in this file! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3328 #ifdef HAVE_GETLOADAVG
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3329 #ifdef HAVE_SYS_LOADAVG_H
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3330 #include <sys/loadavg.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3331 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3332 #else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3333 int getloadavg (double loadavg[], int nelem); /* Defined in getloadavg.c */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3334 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3335
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 DEFUN ("load-average", Fload_average, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 Return list of 1 minute, 5 minute and 15 minute load averages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 Each of the three load averages is multiplied by 100,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 then converted to integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 When USE-FLOATS is non-nil, floats will be used instead of integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 These floats are not multiplied by 100.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 If the 5-minute or 15-minute load averages are not available, return a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 shortened list, containing only those averages which are available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 On some systems, this won't work due to permissions on /dev/kmem,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 in which case you can't use this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 (use_floats))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 double load_ave[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 int loads = getloadavg (load_ave, countof (load_ave));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 Lisp_Object ret = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 if (loads == -2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3357 signal_error (Qunimplemented,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3358 "load-average not implemented for this operating system",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3359 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 else if (loads < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3361 invalid_operation ("Could not get load-average", lisp_strerror (errno));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 while (loads-- > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 Lisp_Object load = (NILP (use_floats) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 make_int ((int) (100.0 * load_ave[loads]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 : make_float (load_ave[loads]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 ret = Fcons (load, ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 Lisp_Object Vfeatures;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 Return non-nil if feature FEXP is present in this Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 Use this to conditionalize execution of lisp code based on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 presence or absence of emacs or environment extensions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 FEXP can be a symbol, a number, or a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 If it is a symbol, that symbol is looked up in the `features' variable,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 and non-nil will be returned if found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 If it is a number, the function will return non-nil if this Emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 has an equal or greater version number than FEXP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 If it is a list whose car is the symbol `and', it will return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 non-nil if all the features in its cdr are non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 If it is a list whose car is the symbol `or', it will return non-nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 if any of the features in its cdr are non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 If it is a list whose car is the symbol `not', it will return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 non-nil if the feature is not present.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 Examples:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 (featurep 'xemacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 => ; Non-nil on XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 (featurep '(and xemacs gnus))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 => ; Non-nil on XEmacs with Gnus loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 (featurep '(or tty-frames (and emacs 19.30)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 => ; Non-nil if this Emacs supports TTY frames.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 (featurep '(or (and xemacs 19.15) (and emacs 19.34)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3406 (featurep '(and xemacs 21.02))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3407 => ; Non-nil on XEmacs 21.2 and later.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3408
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 NOTE: The advanced arguments of this function (anything other than a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 symbol) are not yet supported by FSF Emacs. If you feel they are useful
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 for supporting multiple Emacs variants, lobby Richard Stallman at
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3412 <bug-gnu-emacs@gnu.org>.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 (fexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 #ifndef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 CHECK_SYMBOL (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 #else /* FEATUREP_SYNTAX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 static double featurep_emacs_version;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 /* Brute force translation from Erik Naggum's lisp function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 if (SYMBOLP (fexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 /* Original definition */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428 else if (INTP (fexp) || FLOATP (fexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 double d = extract_float (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 if (featurep_emacs_version == 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 featurep_emacs_version = XINT (Vemacs_major_version) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435 (XINT (Vemacs_minor_version) / 100.0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 return featurep_emacs_version >= d ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 else if (CONSP (fexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441 Lisp_Object tem = XCAR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 if (EQ (tem, Qnot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444 Lisp_Object negate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 tem = XCDR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 negate = Fcar (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 return NILP (call1 (Qfeaturep, negate)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 return Fsignal (Qinvalid_read_syntax, list1 (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 else if (EQ (tem, Qand))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 tem = XCDR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 /* Use Fcar/Fcdr for error-checking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 while (!NILP (tem) && !NILP (call1 (Qfeaturep, Fcar (tem))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 tem = Fcdr (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 return NILP (tem) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 else if (EQ (tem, Qor))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 tem = XCDR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 /* Use Fcar/Fcdr for error-checking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 while (!NILP (tem) && NILP (call1 (Qfeaturep, Fcar (tem))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 tem = Fcdr (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 return NILP (tem) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 return Fsignal (Qinvalid_read_syntax, list1 (XCDR (fexp)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 return Fsignal (Qinvalid_read_syntax, list1 (fexp));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 #endif /* FEATUREP_SYNTAX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 DEFUN ("provide", Fprovide, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 Announce that FEATURE is a feature of the current Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 This function updates the value of the variable `features'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 (feature))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 CHECK_SYMBOL (feature);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 if (!NILP (Vautoload_queue))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 tem = Fmemq (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 Vfeatures = Fcons (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 LOADHIST_ATTACH (Fcons (Qprovide, feature));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 return feature;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 DEFUN ("require", Frequire, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 If feature FEATURE is not loaded, load it from FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 If FEATURE is not a member of the list `features', then the feature
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 is not loaded; so load the file FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 If FILENAME is omitted, the printname of FEATURE is used as the file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3508 (feature, filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 CHECK_SYMBOL (feature);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 tem = Fmemq (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 LOADHIST_ATTACH (Fcons (Qrequire, feature));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 return feature;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 /* Value saved here is to be restored into Vautoload_queue */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 record_unwind_protect (un_autoload, Vautoload_queue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 Vautoload_queue = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3524 call4 (Qload, NILP (filename) ? Fsymbol_name (feature) : filename,
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
3525 Qnil, require_prints_loading_message ? Qrequire : Qt, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 tem = Fmemq (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 if (NILP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3529 invalid_state ("Required feature was not provided", feature);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 /* Once loading finishes, don't undo it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 Vautoload_queue = Qt;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3533 return unbind_to_1 (speccount, feature);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 /* base64 encode/decode functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 Originally based on code from GNU recode. Ported to FSF Emacs by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 Lars Magne Ingebrigtsen and Karl Heuer. Ported to XEmacs and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 subsequently heavily hacked by Hrvoje Niksic. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 #define MIME_LINE_LENGTH 72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 #define IS_ASCII(Character) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 ((Character) < 128)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 #define IS_BASE64(Character) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 (IS_ASCII (Character) && base64_char_to_value[Character] >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 /* Table of characters coding the 64 values. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 static char base64_value_to_char[64] =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', /* 20-29 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', /* 30-39 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', /* 40-49 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', /* 50-59 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 '8', '9', '+', '/' /* 60-63 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 /* Table of base64 values for first 128 characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 static short base64_char_to_value[128] =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 /* The following diagram shows the logical steps by which three octets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 get transformed into four base64 characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 .--------. .--------. .--------.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 |aaaaaabb| |bbbbcccc| |ccdddddd|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 `--------' `--------' `--------'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 6 2 4 4 2 6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 .--------+--------+--------+--------.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 |00aaaaaa|00bbbbbb|00cccccc|00dddddd|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 `--------+--------+--------+--------'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 .--------+--------+--------+--------.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 `--------+--------+--------+--------'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 The octets are divided into 6 bit chunks, which are then encoded into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 base64 characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597
575
d5e8f5ad5043 [xemacs-hg @ 2001-05-25 04:22:31 by martinb]
martinb
parents: 563
diff changeset
3598 static DOESNT_RETURN
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3599 base64_conversion_error (const char *reason, Lisp_Object frob)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3600 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3601 signal_error (Qbase64_conversion_error, reason, frob);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3602 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3603
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3604 #define ADVANCE_INPUT(c, stream) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3605 ((ec = Lstream_get_emchar (stream)) == -1 ? 0 : \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3606 ((ec > 255) ? \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3607 (base64_conversion_error ("Non-ascii character in base64 input", \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3608 make_char (ec)), 0) \
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3609 : (c = (Intbyte)ec), 1))
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3610
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3611 static Bytebpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3612 base64_encode_1 (Lstream *istream, Intbyte *to, int line_break)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 EMACS_INT counter = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3615 Intbyte *e = to;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 Emchar ec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617 unsigned int value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3621 Intbyte c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 if (!ADVANCE_INPUT (c, istream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 /* Wrap line every 76 characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 if (line_break)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 if (counter < MIME_LINE_LENGTH / 4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 counter++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 *e++ = '\n';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 counter = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 /* Process first byte of a triplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 *e++ = base64_value_to_char[0x3f & c >> 2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 value = (0x03 & c) << 4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 /* Process second byte of a triplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 if (!ADVANCE_INPUT (c, istream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644 *e++ = base64_value_to_char[value];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 *e++ = '=';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 *e++ = '=';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 *e++ = base64_value_to_char[value | (0x0f & c >> 4)];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 value = (0x0f & c) << 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 /* Process third byte of a triplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 if (!ADVANCE_INPUT (c, istream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 *e++ = base64_value_to_char[value];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 *e++ = '=';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 *e++ = base64_value_to_char[value | (0x03 & c >> 6)];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 *e++ = base64_value_to_char[0x3f & c];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 return e - to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 #undef ADVANCE_INPUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 /* Get next character from the stream, except that non-base64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 characters are ignored. This is in accordance with rfc2045. EC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671 should be an Emchar, so that it can hold -1 as the value for EOF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 #define ADVANCE_INPUT_IGNORE_NONBASE64(ec, stream, streampos) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 ec = Lstream_get_emchar (stream); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 ++streampos; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 /* IS_BASE64 may not be called with negative arguments so check for \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 EOF first. */ \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 if (ec < 0 || IS_BASE64 (ec) || ec == '=') \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 break; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 } while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 #define STORE_BYTE(pos, val, ccnt) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 ++ccnt; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3686 static Bytebpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3687 base64_decode_1 (Lstream *istream, Intbyte *to, Charcount *ccptr)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 Charcount ccnt = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3690 Intbyte *e = to;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 EMACS_INT streampos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 Emchar ec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 unsigned long value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 /* Process first byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 if (ec < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 if (ec == '=')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3703 base64_conversion_error ("Illegal `=' character while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3704 make_int (streampos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 value = base64_char_to_value[ec] << 18;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 /* Process second byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3710 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3711 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 if (ec == '=')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3713 base64_conversion_error ("Illegal `=' character while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3714 make_int (streampos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 value |= base64_char_to_value[ec] << 12;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 STORE_BYTE (e, value >> 16, ccnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 /* Process third byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3721 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3722 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 if (ec == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3728 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3729 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 if (ec != '=')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3731 base64_conversion_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3732 ("Padding `=' expected but not found while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3733 make_int (streampos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 value |= base64_char_to_value[ec] << 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 STORE_BYTE (e, 0xff & value >> 8, ccnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 /* Process fourth byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3743 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3744 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 if (ec == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 value |= base64_char_to_value[ec];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 STORE_BYTE (e, 0xff & value, ccnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752 *ccptr = ccnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 return e - to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 #undef ADVANCE_INPUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 #undef ADVANCE_INPUT_IGNORE_NONBASE64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 #undef STORE_BYTE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 free_malloced_ptr (Lisp_Object unwind_obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 void *ptr = (void *)get_opaque_ptr (unwind_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 xfree (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 free_opaque_ptr (unwind_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 /* Don't use alloca for regions larger than this, lest we overflow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 the stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 #define MAX_ALLOCA 65536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 /* We need to setup proper unwinding, because there is a number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 ways these functions can blow up, and we don't want to have memory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 leaks in those cases. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 #define XMALLOC_OR_ALLOCA(ptr, len, type) do { \
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3776 Elemcount XOA_len = (len); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 if (XOA_len > MAX_ALLOCA) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 ptr = xnew_array (type, XOA_len); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 record_unwind_protect (free_malloced_ptr, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 make_opaque_ptr ((void *)ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 ptr = alloca_array (type, XOA_len); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 #define XMALLOC_UNBIND(ptr, len, speccount) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 if ((len) > MAX_ALLOCA) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
3789 unbind_to (speccount); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3793 Base64-encode the region between START and END.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 Return the length of the encoded text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 Optional third argument NO-LINE-BREAK means do not break long lines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 into shorter lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3798 (start, end, no_line_break))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3800 Intbyte *encoded;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3801 Bytebpos encoded_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 Charcount allength, length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 struct buffer *buf = current_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3804 Charbpos begv, zv, old_pt = BUF_PT (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 Lisp_Object input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3808 get_buffer_range_char (buf, start, end, &begv, &zv, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 barf_if_buffer_read_only (buf, begv, zv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 /* We need to allocate enough room for encoding the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 We need 33 1/3% more space, plus a newline every 76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 characters, and then we round up. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 length = zv - begv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 allength = length + length/3 + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 allength += allength / MIME_LINE_LENGTH + 1 + 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 input = make_lisp_buffer_input_stream (buf, begv, zv, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 /* We needn't multiply allength with MAX_EMCHAR_LEN because all the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 base64 characters will be single-byte. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3821 XMALLOC_OR_ALLOCA (encoded, allength, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 encoded_length = base64_encode_1 (XLSTREAM (input), encoded,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 NILP (no_line_break));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 if (encoded_length > allength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 /* Now we have encoded the region, so we insert the new contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 and delete the old. (Insert first in order to preserve markers.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 XMALLOC_UNBIND (encoded, allength, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 /* Simulate FSF Emacs implementation of this function: if point was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 in the region, place it at the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 if (old_pt >= begv && old_pt < zv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 BUF_SET_PT (buf, begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 /* We return the length of the encoded text. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 return make_int (encoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 Base64 encode STRING and return the result.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3845 Optional argument NO-LINE-BREAK means do not break long lines
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3846 into shorter lines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 (string, no_line_break))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 Charcount allength, length;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3851 Bytebpos encoded_length;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3852 Intbyte *encoded;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 Lisp_Object input, result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 length = XSTRING_CHAR_LENGTH (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 allength = length + length/3 + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 allength += allength / MIME_LINE_LENGTH + 1 + 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 input = make_lisp_string_input_stream (string, 0, -1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3863 XMALLOC_OR_ALLOCA (encoded, allength, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 encoded_length = base64_encode_1 (XLSTREAM (input), encoded,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 NILP (no_line_break));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 if (encoded_length > allength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 result = make_string (encoded, encoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 XMALLOC_UNBIND (encoded, allength, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874 DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3875 Base64-decode the region between START and END.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 Return the length of the decoded text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 If the region can't be decoded, return nil and don't modify the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 Characters out of the base64 alphabet are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3880 (start, end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882 struct buffer *buf = current_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3883 Charbpos begv, zv, old_pt = BUF_PT (buf);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3884 Intbyte *decoded;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3885 Bytebpos decoded_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3886 Charcount length, cc_decoded_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 Lisp_Object input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3890 get_buffer_range_char (buf, start, end, &begv, &zv, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891 barf_if_buffer_read_only (buf, begv, zv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 length = zv - begv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 input = make_lisp_buffer_input_stream (buf, begv, zv, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896 /* We need to allocate enough room for decoding the text. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3897 XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899 if (decoded_length > length * MAX_EMCHAR_LEN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903 /* Now we have decoded the region, so we insert the new contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 and delete the old. (Insert first in order to preserve markers.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 BUF_SET_PT (buf, begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906 buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 buffer_delete_range (buf, begv + cc_decoded_length,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 zv + cc_decoded_length, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 /* Simulate FSF Emacs implementation of this function: if point was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 in the region, place it at the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913 if (old_pt >= begv && old_pt < zv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 BUF_SET_PT (buf, begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 return make_int (cc_decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 Base64-decode STRING and return the result.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 Characters out of the base64 alphabet are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 (string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3925 Intbyte *decoded;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3926 Bytebpos decoded_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 Charcount length, cc_decoded_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 Lisp_Object input, result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933 length = XSTRING_CHAR_LENGTH (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 /* We need to allocate enough room for decoding the text. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3935 XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 input = make_lisp_string_input_stream (string, 0, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 decoded_length = base64_decode_1 (XLSTREAM (input), decoded,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 &cc_decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 if (decoded_length > length * MAX_EMCHAR_LEN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 result = make_string (decoded, decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 Lisp_Object Qyes_or_no_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 syms_of_fns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3954 INIT_LRECORD_IMPLEMENTATION (bit_vector);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3955
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3956 DEFSYMBOL (Qstring_lessp);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3957 DEFSYMBOL (Qidentity);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3958 DEFSYMBOL (Qyes_or_no_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3959
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3960 DEFERROR_STANDARD (Qbase64_conversion_error, Qconversion_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 DEFSUBR (Fidentity);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 DEFSUBR (Frandom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 DEFSUBR (Flength);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 DEFSUBR (Fsafe_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 DEFSUBR (Fstring_equal);
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
3967 DEFSUBR (Fcompare_strings);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 DEFSUBR (Fstring_lessp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969 DEFSUBR (Fstring_modified_tick);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970 DEFSUBR (Fappend);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 DEFSUBR (Fconcat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 DEFSUBR (Fvconcat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 DEFSUBR (Fbvconcat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 DEFSUBR (Fcopy_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975 DEFSUBR (Fcopy_sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976 DEFSUBR (Fcopy_alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 DEFSUBR (Fcopy_tree);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 DEFSUBR (Fsubstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 DEFSUBR (Fsubseq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 DEFSUBR (Fnthcdr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 DEFSUBR (Fnth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 DEFSUBR (Felt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 DEFSUBR (Flast);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 DEFSUBR (Fbutlast);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 DEFSUBR (Fnbutlast);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 DEFSUBR (Fmember);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 DEFSUBR (Fold_member);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 DEFSUBR (Fmemq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 DEFSUBR (Fold_memq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 DEFSUBR (Fassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 DEFSUBR (Fold_assoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 DEFSUBR (Fassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993 DEFSUBR (Fold_assq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 DEFSUBR (Frassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 DEFSUBR (Fold_rassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 DEFSUBR (Frassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 DEFSUBR (Fold_rassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 DEFSUBR (Fdelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 DEFSUBR (Fold_delete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 DEFSUBR (Fdelq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 DEFSUBR (Fold_delq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002 DEFSUBR (Fremassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003 DEFSUBR (Fremassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 DEFSUBR (Fremrassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 DEFSUBR (Fremrassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006 DEFSUBR (Fnreverse);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 DEFSUBR (Freverse);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008 DEFSUBR (Fsort);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009 DEFSUBR (Fplists_eq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 DEFSUBR (Fplists_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011 DEFSUBR (Flax_plists_eq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012 DEFSUBR (Flax_plists_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 DEFSUBR (Fplist_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 DEFSUBR (Fplist_put);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 DEFSUBR (Fplist_remprop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 DEFSUBR (Fplist_member);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017 DEFSUBR (Fcheck_valid_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 DEFSUBR (Fvalid_plist_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 DEFSUBR (Fcanonicalize_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 DEFSUBR (Flax_plist_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 DEFSUBR (Flax_plist_put);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 DEFSUBR (Flax_plist_remprop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 DEFSUBR (Flax_plist_member);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 DEFSUBR (Fcanonicalize_lax_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 DEFSUBR (Fdestructive_alist_to_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 DEFSUBR (Fget);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 DEFSUBR (Fput);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 DEFSUBR (Fremprop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 DEFSUBR (Fobject_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 DEFSUBR (Fequal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031 DEFSUBR (Fold_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 DEFSUBR (Ffillarray);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 DEFSUBR (Fnconc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 DEFSUBR (Fmapcar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 DEFSUBR (Fmapvector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 DEFSUBR (Fmapc_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 DEFSUBR (Fmapconcat);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4038 DEFSUBR (Freplace_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039 DEFSUBR (Fload_average);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040 DEFSUBR (Ffeaturep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4041 DEFSUBR (Frequire);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4042 DEFSUBR (Fprovide);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4043 DEFSUBR (Fbase64_encode_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 DEFSUBR (Fbase64_encode_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 DEFSUBR (Fbase64_decode_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 DEFSUBR (Fbase64_decode_string);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4047
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4048 DEFSUBR (Fsplit_string_by_char);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4049 DEFSUBR (Fsplit_path); /* #### */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4050 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4051
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4052 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4053 vars_of_fns (void)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4054 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4055 DEFVAR_LISP ("path-separator", &Vpath_separator /*
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4056 The directory separator in search paths, as a string.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4057 */ );
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4058 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4059 char c = SEPCHAR;
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
4060 Vpath_separator = make_string ((Intbyte *) &c, 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 751
diff changeset
4061 }
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
4062
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
4063 DEFVAR_BOOL ("require-prints-loading-message",
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
4064 &require_prints_loading_message /*
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
4065 If non-nil, every time a file is loaded by `require' a message is printed.
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
4066 */ );
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 init_provide_once (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 DEFVAR_LISP ("features", &Vfeatures /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073 A list of symbols which are the features of the executing emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 Used by `featurep' and `require', and altered by `provide'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 Vfeatures = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078 Fprovide (intern ("base64"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 }