annotate src/fns.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents b39c14581166
children 358bd84dc7ff
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995, 1996 Ben Wing.
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"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "device.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "extents.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 /* NOTE: This symbol is also used in lread.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #define FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 Lisp_Object Qstring_lessp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Lisp_Object Qidentity;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
58 Lisp_Object Qbase64_conversion_error;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
59
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
61 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
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 mark_bit_vector (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
72 Elemcount i;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
73 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
74 Elemcount len = bit_vector_length (v);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
75 Elemcount last = len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 if (INTP (Vprint_length))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 last = min (len, XINT (Vprint_length));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 write_c_string ("#*", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 for (i = 0; i < last; i++)
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 (bit_vector_bit (v, i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 write_c_string ("1", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 write_c_string ("0", printcharfun);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 if (last != len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 write_c_string ("...", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
95 Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
96 Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 !memcmp (v1->bits, v2->bits,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 sizeof (long)));
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
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
104 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 bit_vector_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
107 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 return HASH2 (bit_vector_length (v),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 memory_hash (v->bits,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 sizeof (long)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
114 static Bytecount
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
115 size_bit_vector (const void *lheader)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
116 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
117 Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader;
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 454
diff changeset
118 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
119 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
120 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
121
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 static const struct lrecord_description bit_vector_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
123 { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
128 DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION ("bit-vector", bit_vector,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
129 mark_bit_vector, print_bit_vector, 0,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
130 bit_vector_equal, bit_vector_hash,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
131 bit_vector_description, size_bit_vector,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
132 Lisp_Bit_Vector);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 DEFUN ("identity", Fidentity, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 Return the argument unchanged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (arg))
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 return arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 }
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 extern long get_random (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 extern void seed_random (long arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 DEFUN ("random", Frandom, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 Return a pseudo-random number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 All integers representable in Lisp are equally likely.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 On most systems, this is 28 bits' worth.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 With positive integer argument N, return random number in interval [0,N).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 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
151 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (limit))
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 EMACS_INT val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 unsigned long denominator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 if (EQ (limit, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 seed_random (getpid () + time (NULL));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 if (NATNUMP (limit) && !ZEROP (limit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 /* Try to take our random number from the higher bits of VAL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 not the lower, since (says Gentzel) the low bits of `random'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 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
164 quotient rather than the remainder. At the high end of the RNG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 it's possible to get a quotient larger than limit; discarding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 these values eliminates the bias that would otherwise appear
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 when using a large limit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 denominator = ((unsigned long)1 << VALBITS) / XINT (limit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 val = get_random () / denominator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 while (val >= XINT (limit));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 val = get_random ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 return make_int (val);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 /* Random data-structure functions */
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 #ifdef LOSING_BYTECODE
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 /* #### Delete this shit */
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 /* Charcount is a misnomer here as we might be dealing with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 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
187 with Bytecounts in strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 static Charcount
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 length_with_bytecode_hack (Lisp_Object seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 if (!COMPILED_FUNCTIONP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 return XINT (Flength (seq));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
195 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 return (f->flags.interactivep ? COMPILED_INTERACTIVE :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 f->flags.domainp ? COMPILED_DOMAIN :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 COMPILED_DOC_STRING)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 }
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 #endif /* LOSING_BYTECODE */
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 void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
207 check_losing_bytecode (const char *function, Lisp_Object seq)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 if (COMPILED_FUNCTIONP (seq))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
210 signal_ferror_with_frob
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
211 (Qinvalid_argument, seq,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 "As of 20.3, `%s' no longer works with compiled-function objects",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 DEFUN ("length", Flength, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Return the length of vector, bit vector, list or string SEQUENCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (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 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 if (STRINGP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return make_int (XSTRING_CHAR_LENGTH (sequence));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 else if (CONSP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
226 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 GET_EXTERNAL_LIST_LENGTH (sequence, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 return make_int (len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 else if (VECTORP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 return make_int (XVECTOR_LENGTH (sequence));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 else if (NILP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 else if (BIT_VECTORP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 return make_int (bit_vector_length (XBIT_VECTOR (sequence)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 check_losing_bytecode ("length", sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 sequence = wrong_type_argument (Qsequencep, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 }
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 DEFUN ("safe-length", Fsafe_length, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 Return the length of a list, but avoid error or infinite loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 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
247 it returns 0. If LIST is circular, it returns a finite value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 which is at least the number of distinct elements.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (list))
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 Lisp_Object hare, tortoise;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
253 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 for (hare = tortoise = list, len = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 hare = XCDR (hare), len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 return make_int (len);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 /*** string functions. ***/
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 DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 Return t if two strings have identical contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 Case is significant. Text properties are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 \(Under XEmacs, `equal' also ignores text properties and extents in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 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
273 `equal' is the same as in XEmacs, in that respect.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 Symbols are also allowed; their print names are used instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
276 (string1, string2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 Bytecount len;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
279 Lisp_String *p1, *p2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
281 if (SYMBOLP (string1))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
282 p1 = XSYMBOL (string1)->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
285 CHECK_STRING (string1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
286 p1 = XSTRING (string1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
289 if (SYMBOLP (string2))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
290 p2 = XSYMBOL (string2)->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
293 CHECK_STRING (string2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
294 p2 = XSTRING (string2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 return (((len = string_length (p1)) == string_length (p2)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 !memcmp (string_data (p1), string_data (p2), len)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
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 DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 Return t if first arg string is less than second in lexicographic order.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 If I18N2 support (but not Mule support) was compiled in, ordering is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 determined by the locale. (Case is significant for the default C locale.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 In all other cases, comparison is simply done on a character-by-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 character basis using the numeric value of a character. (Note that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 this may not produce particularly meaningful results under Mule if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 characters from different charsets are being compared.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 Symbols are also allowed; their print names are used instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 The reason that the I18N2 locale-specific collation is not used under
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 Mule is that the locale model of internationalization does not handle
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 multiple charsets and thus has no hope of working properly under Mule.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 What we really should do is create a collation table over all built-in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 charsets. This is extremely difficult to do from scratch, however.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 Unicode is a good first step towards solving this problem. In fact,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 it is quite likely that a collation table exists (or will exist) for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 Unicode. When Unicode support is added to XEmacs/Mule, this problem
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 may be solved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
324 (string1, string2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
326 Lisp_String *p1, *p2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 Charcount end, len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
330 if (SYMBOLP (string1))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
331 p1 = XSYMBOL (string1)->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
334 CHECK_STRING (string1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
335 p1 = XSTRING (string1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
338 if (SYMBOLP (string2))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
339 p2 = XSYMBOL (string2)->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
342 CHECK_STRING (string2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
343 p2 = XSTRING (string2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 end = string_char_length (p1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 len2 = string_char_length (p2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 if (end > len2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 end = len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 #if defined (I18N2) && !defined (MULE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 /* There is no hope of this working under Mule. Even if we converted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 the data into an external format so that strcoll() processed it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 properly, it would still not work because strcoll() does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 handle multiple locales. This is the fundamental flaw in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 locale model. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 Bytecount bcend = charcount_to_bytecount (string_data (p1), end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 /* Compare strings using collation order of locale. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 /* Need to be tricky to handle embedded nulls. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 int val = strcoll ((char *) string_data (p1) + i,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (char *) string_data (p2) + i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 if (val < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 if (val > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 #else /* not I18N2, or MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
374 Intbyte *ptr1 = string_data (p1);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
375 Intbyte *ptr2 = string_data (p2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 /* #### It is not really necessary to do this: We could compare
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 byte-by-byte and still get a reasonable comparison, since this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 would compare characters with a charset in the same way. With
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 a little rearrangement of the leading bytes, we could make most
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 inter-charset comparisons work out the same, too; even if some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 don't, this is not a big deal because inter-charset comparisons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 aren't really well-defined anyway. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 for (i = 0; i < end; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 if (charptr_emchar (ptr1) != charptr_emchar (ptr2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 return charptr_emchar (ptr1) < charptr_emchar (ptr2) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 INC_CHARPTR (ptr1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 INC_CHARPTR (ptr2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 #endif /* not I18N2, or MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 /* Can't do i < len2 because then comparison between "foo" and "foo^@"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 won't work right in I18N2 case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 return end < len2 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 DEFUN ("string-modified-tick", Fstring_modified_tick, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 Return STRING's tick counter, incremented for each change to the string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 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
401 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
402 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
405 Lisp_String *s;
428
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 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 s = XSTRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 if (CONSP (s->plist) && INTP (XCAR (s->plist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 return XCAR (s->plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 bump_string_modiff (Lisp_Object str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
418 Lisp_String *s = XSTRING (str);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 Lisp_Object *ptr = &s->plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 /* #### remove the `string-translatable' property from the string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 if there is one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 /* skip over extent info if it's there */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 ptr = &XCDR (*ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 if (CONSP (*ptr) && INTP (XCAR (*ptr)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 XSETINT (XCAR (*ptr), 1+XINT (XCAR (*ptr)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 *ptr = Fcons (make_int (1), *ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 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
436 static Lisp_Object concat (int nargs, Lisp_Object *args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 enum concat_target_type target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 int last_special);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
441 concat2 (Lisp_Object string1, Lisp_Object string2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 Lisp_Object args[2];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
444 args[0] = string1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
445 args[1] = string2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 return concat (2, args, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
450 concat3 (Lisp_Object string1, Lisp_Object string2, Lisp_Object string3)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 Lisp_Object args[3];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
453 args[0] = string1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
454 args[1] = string2;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
455 args[2] = string3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 return concat (3, args, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 }
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 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
460 vconcat2 (Lisp_Object vec1, Lisp_Object vec2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 Lisp_Object args[2];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
463 args[0] = vec1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
464 args[1] = vec2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 return concat (2, args, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
469 vconcat3 (Lisp_Object vec1, Lisp_Object vec2, Lisp_Object vec3)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 Lisp_Object args[3];
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
472 args[0] = vec1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
473 args[1] = vec2;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
474 args[2] = vec3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 return concat (3, args, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 }
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 DEFUN ("append", Fappend, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 Concatenate all the arguments and make the result a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 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
481 Each argument may be a list, vector, bit vector, or string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 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
483 Also see: `nconc'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 return concat (nargs, args, c_cons, 1);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 DEFUN ("concat", Fconcat, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 Concatenate all the arguments and make the result a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 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
493 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
494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 As of XEmacs 21.0, this function does NOT accept individual integers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 as arguments. Old code that relies on, for example, (concat "foo" 50)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 returning "foo50" will fail. To fix such code, either apply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 `int-to-string' to the integer argument, or use `format'.
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 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 return concat (nargs, args, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 DEFUN ("vconcat", Fvconcat, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 Concatenate all the arguments and make the result a vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 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
508 Each argument may be a list, vector, bit vector, or string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 return concat (nargs, args, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 }
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 DEFUN ("bvconcat", Fbvconcat, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 Concatenate all the arguments and make the result a bit vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 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
518 arguments. Each argument may be a list, vector, bit vector, or string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 return concat (nargs, args, c_bit_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 }
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 /* Copy a (possibly dotted) list. LIST must be a cons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 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
527 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 copy_list (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 Lisp_Object last = list_copy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 Lisp_Object hare, tortoise;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
533 Elemcount len;
428
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 for (tortoise = hare = XCDR (list), len = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 CONSP (hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 hare = XCDR (hare), len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 XCDR (last) = Fcons (XCAR (hare), XCDR (hare));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 last = XCDR (last);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 if (len < CIRCULAR_LIST_SUSPICION_LENGTH)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 if (EQ (tortoise, hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 signal_circular_list_error (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 }
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 return list_copy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 }
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 DEFUN ("copy-list", Fcopy_list, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 Return a copy of list LIST, which may be a dotted list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 The elements of LIST are not copied; they are shared
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 with the original.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (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 again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 if (NILP (list)) return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 if (CONSP (list)) return copy_list (list);
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 list = wrong_type_argument (Qlistp, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 goto again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 Return a copy of list, vector, bit vector or string SEQUENCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 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
571 with the original. SEQUENCE may be a dotted list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (sequence))
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 again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 if (NILP (sequence)) return sequence;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 if (CONSP (sequence)) return copy_list (sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 if (STRINGP (sequence)) return concat (1, &sequence, c_string, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 if (VECTORP (sequence)) return concat (1, &sequence, c_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 if (BIT_VECTORP (sequence)) return concat (1, &sequence, c_bit_vector, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 check_losing_bytecode ("copy-sequence", sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 sequence = wrong_type_argument (Qsequencep, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 goto again;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 struct merge_string_extents_struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 Lisp_Object string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 Bytecount entry_offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 Bytecount entry_length;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 concat (int nargs, Lisp_Object *args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 enum concat_target_type target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 int last_special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 Lisp_Object tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 int toindex;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 Lisp_Object last_tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 Lisp_Object prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 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
606 Intbyte *string_result = 0;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
607 Intbyte *string_result_ptr = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 struct gcpro gcpro1;
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 /* The modus operandi in Emacs is "caller gc-protects args".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 However, concat is called many times in Emacs on freshly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 created stuff. So we help those callers out by protecting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 the args ourselves to save them a lot of temporary-variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 grief. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 GCPRO1 (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 gcpro1.nvars = nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 /* #### 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
621 for the `string-translatable' property, then concat should also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 concat the args but use the `string-translatable' strings, and store
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 the result in the returned string's `string-translatable' property. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 if (target_type == c_string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 args_mse = alloca_array (struct merge_string_extents_struct, nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 /* In append, the last arg isn't treated like the others */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 if (last_special && nargs > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 nargs--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 last_tail = args[nargs];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 last_tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 /* Check and coerce the arguments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 Lisp_Object seq = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 if (LISTP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 else if (VECTORP (seq) || STRINGP (seq) || BIT_VECTORP (seq))
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 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 else if (COMPILED_FUNCTIONP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 /* Urk! We allow this, for "compatibility"... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 #if 0 /* removed for XEmacs 21 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 else if (INTP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 /* This is too revolting to think about but maintains
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 compatibility with FSF (and lots and lots of old code). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 args[argnum] = Fnumber_to_string (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 check_losing_bytecode ("concat", seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 args[argnum] = wrong_type_argument (Qsequencep, seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 if (args_mse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 if (STRINGP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 args_mse[argnum].string = seq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 args_mse[argnum].string = Qnil;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
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 /* Charcount is a misnomer here as we might be dealing with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 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
674 with Bytecounts in strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 Charcount total_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 for (argnum = 0, total_length = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 Charcount thislen = length_with_bytecode_hack (args[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 Charcount thislen = XINT (Flength (args[argnum]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 total_length += thislen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 switch (target_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 case c_cons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 if (total_length == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 /* In append, if all but last arg are nil, return last arg */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 RETURN_UNGCPRO (last_tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 val = Fmake_list (make_int (total_length), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 case c_vector:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 val = make_vector (total_length, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 case c_bit_vector:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 val = make_bit_vector (total_length, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 case c_string:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 /* 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
703 actual number of bytes. This loop was formerly written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 to call Fmake_string() here and then call set_string_char()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 for each char. This seems logical enough but is waaaaaaaay
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 slow -- set_string_char() has to scan the whole string up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 to the place where the substitution is called for in order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 to find the place to change, and may have to do some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 realloc()ing in order to make the char fit properly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 O(N^2) yuckage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 val = Qnil;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
712 string_result = (Intbyte *) alloca (total_length * MAX_EMCHAR_LEN);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 string_result_ptr = string_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 default:
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
716 val = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 if (CONSP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 tail = val, toindex = -1; /* -1 in toindex is flag we are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 making a list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 toindex = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 prev = Qnil;
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 for (argnum = 0; argnum < nargs; argnum++)
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 Charcount thisleni = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 Charcount thisindex = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 Lisp_Object seq = args[argnum];
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
735 Intbyte *string_source_ptr = 0;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
736 Intbyte *string_prev_result_ptr = string_result_ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 if (!CONSP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 thisleni = length_with_bytecode_hack (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 thisleni = XINT (Flength (seq));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 if (STRINGP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 string_source_ptr = XSTRING_DATA (seq);
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 while (1)
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 Lisp_Object elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 /* We've come to the end of this arg, so exit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 if (NILP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 break;
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 /* Fetch next element of `seq' arg into `elt' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 if (CONSP (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 elt = XCAR (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 seq = XCDR (seq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 if (thisindex >= thisleni)
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 if (STRINGP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 elt = make_char (charptr_emchar (string_source_ptr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 INC_CHARPTR (string_source_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 else if (VECTORP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 elt = XVECTOR_DATA (seq)[thisindex];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 else if (BIT_VECTORP (seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 elt = make_int (bit_vector_bit (XBIT_VECTOR (seq),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 thisindex));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 elt = Felt (seq, make_int (thisindex));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 thisindex++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 /* Store into result */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 if (toindex < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 /* toindex negative means we are making a list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 XCAR (tail) = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 else if (VECTORP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 XVECTOR_DATA (val)[toindex++] = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 else if (BIT_VECTORP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 CHECK_BIT (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 set_bit_vector_bit (XBIT_VECTOR (val), toindex++, XINT (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 CHECK_CHAR_COERCE_INT (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 string_result_ptr += set_charptr_emchar (string_result_ptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 XCHAR (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 if (args_mse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 args_mse[argnum].entry_offset =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 string_prev_result_ptr - string_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 args_mse[argnum].entry_length =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 string_result_ptr - string_prev_result_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 /* Now we finally make the string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 if (target_type == c_string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 val = make_string (string_result, string_result_ptr - string_result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 if (STRINGP (args_mse[argnum].string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 copy_string_extents (val, args_mse[argnum].string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 args_mse[argnum].entry_offset, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 args_mse[argnum].entry_length);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 if (!NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 XCDR (prev) = last_tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 RETURN_UNGCPRO (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 DEFUN ("copy-alist", Fcopy_alist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 Return a copy of ALIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 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
836 but does not share the alist structure with ALIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 The objects mapped (cars and cdrs of elements of the alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 are shared, however.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 Elements of ALIST that are not conses are also shared.
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 (alist))
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 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 if (NILP (alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 return alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 CHECK_CONS (alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 alist = concat (1, &alist, c_cons, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 for (tail = alist; CONSP (tail); tail = XCDR (tail))
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 Lisp_Object car = XCAR (tail);
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 if (CONSP (car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 XCAR (tail) = Fcons (XCAR (car), XCDR (car));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 }
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 }
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 DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 Return a copy of a list and substructures.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 The argument is copied, and any lists contained within it are copied
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 recursively. Circularities and shared substructures are not preserved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 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
865 are not copied.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 (arg, vecp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 {
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
869 return safe_copy_tree (arg, vecp, 0);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
870 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
871
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
872 Lisp_Object
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
873 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
874 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
875 if (depth > 200)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
876 stack_overflow ("Stack overflow in copy-tree", arg);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
877
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 if (CONSP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 rest = arg = Fcopy_sequence (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 while (CONSP (rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 Lisp_Object elt = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 if (CONSP (elt) || VECTORP (elt))
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
887 XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
889 XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 rest = XCDR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 else if (VECTORP (arg) && ! NILP (vecp))
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 int i = XVECTOR_LENGTH (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 arg = Fcopy_sequence (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 for (j = 0; j < i; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 Lisp_Object elt = XVECTOR_DATA (arg) [j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 if (CONSP (elt) || VECTORP (elt))
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
903 XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 }
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 return arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 DEFUN ("substring", Fsubstring, 2, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
910 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
911 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
912 If START or END is negative, it counts from the end.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
913 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
914 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
915 (string, start, end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
917 Charcount ccstart, ccend;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
918 Bytecount bstart, blen;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 CHECK_STRING (string);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
922 CHECK_INT (start);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
923 get_string_range_char (string, start, end, &ccstart, &ccend,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 GB_HISTORICAL_STRING_BEHAVIOR);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
925 bstart = charcount_to_bytecount (XSTRING_DATA (string), ccstart);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
926 blen = charcount_to_bytecount (XSTRING_DATA (string) + bstart, ccend - ccstart);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
927 val = make_string (XSTRING_DATA (string) + bstart, blen);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
928 /* Copy any applicable extent information into the new string. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
929 copy_string_extents (val, string, 0, bstart, blen);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 return 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
934 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
935 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
936 If START or END is negative, it counts from the end.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
937 The returned subsequence is always of the same type as SEQUENCE.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
938 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
939 are copied to the new string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 (sequence, start, end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 EMACS_INT len, s, e;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 if (STRINGP (sequence))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 return Fsubstring (sequence, start, end);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 len = XINT (Flength (sequence));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 CHECK_INT (start);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 s = XINT (start);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
952 if (s < 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
953 s = len + s;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955 if (NILP (end))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
956 e = len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
959 CHECK_INT (end);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
960 e = XINT (end);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
961 if (e < 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962 e = len + e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
965 if (!(0 <= s && s <= e && e <= len))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
966 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
967
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
968 if (VECTORP (sequence))
428
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 Lisp_Object result = make_vector (e - s, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 EMACS_INT i;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
972 Lisp_Object *in_elts = XVECTOR_DATA (sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 Lisp_Object *out_elts = XVECTOR_DATA (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
975 for (i = s; i < e; i++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
976 out_elts[i - s] = in_elts[i];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
979 else if (LISTP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 EMACS_INT i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984 sequence = Fnthcdr (make_int (s), sequence);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
985
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
986 for (i = s; i < e; i++)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
988 result = Fcons (Fcar (sequence), result);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989 sequence = Fcdr (sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 }
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 return Fnreverse (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
994 else if (BIT_VECTORP (sequence))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
995 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
996 Lisp_Object result = make_bit_vector (e - s, Qzero);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
997 EMACS_INT i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
998
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
999 for (i = s; i < e; i++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1000 set_bit_vector_bit (XBIT_VECTOR (result), i - s,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1001 bit_vector_bit (XBIT_VECTOR (sequence), i));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1002 return result;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1003 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1004 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1005 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1006 abort (); /* unreachable, since Flength (sequence) did not get
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1007 an error */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1008 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1009 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 Take cdr N times on LIST, and return the result.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 (n, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1018 REGISTER EMACS_INT i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 for (i = XINT (n); i; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 if (CONSP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 else if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 tail = wrong_type_argument (Qlistp, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 i++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 DEFUN ("nth", Fnth, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 Return the Nth element of LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 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
1039 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 (n, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 return Fcar (Fnthcdr (n, list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 DEFUN ("elt", Felt, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 Return element of SEQUENCE at index N.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (sequence, n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 CHECK_INT_COERCE_CHAR (n); /* yuck! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 if (LISTP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 Lisp_Object tem = Fnthcdr (n, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 /* #### Utterly, completely, fucking disgusting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 * #### The whole point of "elt" is that it operates on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 * #### sequences, and does error- (bounds-) checking.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 if (CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 return XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 #if 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 /* This is The Way It Has Always Been. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 /* This is The Way Mly and Cltl2 say It Should Be. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 args_out_of_range (sequence, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 else if (STRINGP (sequence) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 VECTORP (sequence) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 BIT_VECTORP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 return Faref (sequence, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 else if (COMPILED_FUNCTIONP (sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 EMACS_INT idx = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 if (idx < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 lose:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 args_out_of_range (sequence, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 /* Utter perversity */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 switch (idx)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 case COMPILED_ARGLIST:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 return compiled_function_arglist (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 case COMPILED_INSTRUCTIONS:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 return compiled_function_instructions (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 case COMPILED_CONSTANTS:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 return compiled_function_constants (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 case COMPILED_STACK_DEPTH:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 return compiled_function_stack_depth (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 case COMPILED_DOC_STRING:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 return compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 case COMPILED_DOMAIN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 return compiled_function_domain (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 case COMPILED_INTERACTIVE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 return compiled_function_interactive (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 /* if we return nil, can't tell interactive with no args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 from noninteractive. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 #endif /* LOSING_BYTECODE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 check_losing_bytecode ("elt", sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 sequence = wrong_type_argument (Qsequencep, sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 DEFUN ("last", Flast, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 Return the tail of list LIST, of length N (default 1).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 LIST may be a dotted list, but not a circular list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 Optional argument N must be a non-negative integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 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
1125 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
1126 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 (list, n))
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 EMACS_INT int_n, count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 Lisp_Object retval, tortoise, hare;
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 CHECK_LIST (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 if (NILP (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 int_n = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 int_n = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 for (retval = tortoise = hare = list, count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 CONSP (hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 hare = XCDR (hare),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 (int_n-- <= 0 ? ((void) (retval = XCDR (retval))) : (void)0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 count++)
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 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 if (count & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 if (EQ (hare, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 signal_circular_list_error (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 }
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 return retval;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 Modify LIST to remove the last N (default 1) elements.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 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
1162 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 (list, n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 EMACS_INT int_n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 CHECK_LIST (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 if (NILP (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 int_n = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 int_n = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 Lisp_Object last_cons = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 EXTERNAL_LIST_LOOP_1 (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 if (int_n-- < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 last_cons = XCDR (last_cons);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 }
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 if (int_n >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 XCDR (last_cons) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 DEFUN ("butlast", Fbutlast, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 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
1196 If LIST has N or fewer elements, nil is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 (list, n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1200 EMACS_INT int_n;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 CHECK_LIST (list);
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 if (NILP (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 int_n = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 CHECK_NATNUM (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 int_n = XINT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 Lisp_Object retval = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 EXTERNAL_LIST_LOOP_1 (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 if (--int_n < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 retval = Fcons (XCAR (tail), retval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 }
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 return Fnreverse (retval);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 DEFUN ("member", Fmember, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 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
1231 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 (elt, list))
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 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 if (internal_equal (elt, list_elt, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 }
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 DEFUN ("old-member", Fold_member, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 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
1245 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 Do not use it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 if (internal_old_equal (elt, list_elt, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 DEFUN ("memq", Fmemq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 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
1261 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 DEFUN ("old-memq", Fold_memq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 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
1275 The value is actually the tail of LIST whose car is ELT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 Do not use it.
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 (elt, list))
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 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
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 if (HACKEQ_UNSAFE (elt, list_elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 }
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 memq_no_quit (Lisp_Object elt, Lisp_Object list)
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 LIST_LOOP_3 (list_elt, list, tail)
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 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 return tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 DEFUN ("assoc", Fassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1301 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
1302 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
1303 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1304 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 /* This function can GC. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1307 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
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 if (internal_equal (key, elt_car, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1316 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
1317 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
1318 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1319 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 /* This function can GC. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1322 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
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 if (internal_old_equal (key, elt_car, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 return elt;
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 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1331 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 specbind (Qinhibit_quit, Qt);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1335 return unbind_to (speccount, Fassoc (key, alist));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 DEFUN ("assq", Fassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1339 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
1340 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
1341 Elements of ALIST that are not conses are ignored.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1343 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1345 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 }
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 DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1354 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
1355 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
1356 Elements of ALIST that are not conses are ignored.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 Do not use it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1360 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1362 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 if (HACKEQ_UNSAFE (key, elt_car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 return elt;
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 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 /* Like Fassq but never report an error and do not allow quits.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 Use only on lists known never to be circular. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1374 assq_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 /* This cannot GC. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1377 LIST_LOOP_2 (elt, alist)
428
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 Lisp_Object elt_car = XCAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 return elt;
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 }
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 DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1387 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
1388 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
1389 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1390 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1392 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1394 if (internal_equal (value, elt_cdr, 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 return elt;
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 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1401 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
1402 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
1403 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1404 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1406 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1408 if (internal_old_equal (value, elt_cdr, 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 DEFUN ("rassq", Frassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1415 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
1416 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
1417 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1418 (value, alist))
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 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1422 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 return elt;
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 }
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 DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1429 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
1430 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
1431 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1432 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1434 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1436 if (HACKEQ_UNSAFE (value, elt_cdr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 return elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1442 /* Like Frassq, but caller must ensure that ALIST is properly
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 nil-terminated and ebola-free. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1445 rassq_no_quit (Lisp_Object value, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1447 LIST_LOOP_2 (elt, 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 Lisp_Object elt_cdr = XCDR (elt);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1450 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 return elt;
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 DEFUN ("delete", Fdelete, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 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
1459 The modified LIST is returned. Comparison is done with `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 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
1461 effect; therefore, write `(setq foo (delete element foo))' to be sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 of changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 Also see: `remove'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 (internal_equal (elt, list_elt, 0)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 DEFUN ("old-delete", Fold_delete, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 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
1474 The modified LIST is returned. Comparison is done with `old-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 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
1476 effect; therefore, write `(setq foo (old-delete element foo))' to be sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 of changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 (internal_old_equal (elt, list_elt, 0)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 return list;
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 DEFUN ("delq", Fdelq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 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
1488 The modified LIST is returned. Comparison is done with `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 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
1490 effect; therefore, write `(setq foo (delq element foo))' to be sure of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 (elt, list))
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 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 return list;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 DEFUN ("old-delq", Fold_delq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 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
1502 The modified LIST is returned. Comparison is done with `old-eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 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
1504 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
1505 changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 (elt, list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 (HACKEQ_UNSAFE (elt, list_elt)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 return list;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 /* Like Fdelq, but caller must ensure that LIST is properly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 nil-terminated and ebola-free. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 delq_no_quit (Lisp_Object elt, Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 LIST_LOOP_DELETE_IF (list_elt, list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 /* Be VERY careful with this. This is like delq_no_quit() but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 also calls free_cons() on the removed conses. You must be SURE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 that no pointers to the freed conses remain around (e.g.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 someone else is pointing to part of the list). This function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 is useful on internal lists that are used frequently and where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 the actual list doesn't escape beyond known code bounds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 REGISTER Lisp_Object tem = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 if (EQ (elt, tem))
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 Lisp_Object cons_to_free = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 list = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 XCDR (prev) = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 free_cons (XCONS (cons_to_free));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 }
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 return list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 DEFUN ("remassoc", Fremassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1561 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
1562 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
1563 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
1564 therefore, write `(setq foo (remassoc key foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1567 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1569 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 internal_equal (key, XCAR (elt), 0)));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1572 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1576 remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 specbind (Qinhibit_quit, Qt);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1580 return unbind_to (speccount, Fremassoc (key, alist));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 }
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 DEFUN ("remassq", Fremassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1584 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
1585 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
1586 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
1587 therefore, write `(setq foo (remassq key foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1590 (key, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1592 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1595 return alist;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 /* no quit, no errors; be careful */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1601 remassq_no_quit (Lisp_Object key, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1603 LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1606 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 }
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 DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1610 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
1611 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
1612 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
1613 therefore, write `(setq foo (remrassoc value foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1616 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1618 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 internal_equal (value, XCDR (elt), 0)));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1621 return alist;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 DEFUN ("remrassq", Fremrassq, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1625 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
1626 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
1627 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
1628 therefore, write `(setq foo (remrassq value foo))' to be sure of changing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1631 (value, alist))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1633 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1636 return alist;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 /* Like Fremrassq, fast and unsafe; be careful */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1641 remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1643 LIST_LOOP_DELETE_IF (elt, alist,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 (CONSP (elt) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1646 return alist;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 Reverse LIST by destructively modifying cdr pointers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 Return the beginning of the reversed list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 Also see: `reverse'.
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 (list))
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 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 /* We gcpro our args; see `nconc' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 GCPRO2 (prev, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 REGISTER Lisp_Object next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 CONCHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 next = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 XCDR (tail) = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 tail = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 return prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 }
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 DEFUN ("reverse", Freverse, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 Reverse LIST, copying. Return the beginning of the reversed list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 See also the function `nreverse', which is used more often.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 Lisp_Object reversed_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 EXTERNAL_LIST_LOOP_2 (elt, list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 reversed_list = Fcons (elt, reversed_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 return reversed_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 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
1690 Lisp_Object lisp_arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 int (*pred_fn) (Lisp_Object, Lisp_Object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 Lisp_Object lisp_arg));
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 list_sort (Lisp_Object list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 Lisp_Object lisp_arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 int (*pred_fn) (Lisp_Object, Lisp_Object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 Lisp_Object lisp_arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 Lisp_Object back, tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 Lisp_Object front = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 Lisp_Object len = Flength (list);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1704
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1705 if (XINT (len) < 2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 return list;
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 len = make_int (XINT (len) / 2 - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 tem = Fnthcdr (len, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 back = Fcdr (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 Fsetcdr (tem, Qnil);
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 GCPRO3 (front, back, lisp_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 front = list_sort (front, lisp_arg, pred_fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 back = list_sort (back, lisp_arg, pred_fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 return list_merge (front, back, lisp_arg, pred_fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 merge_pred_function (Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 Lisp_Object pred)
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 Lisp_Object tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 /* prevents the GC from happening in call2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 /* Emacs' GC doesn't actually relocate pointers, so this probably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 isn't strictly necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 record_unwind_protect (restore_gc_inhibit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 make_int (gc_currently_forbidden));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 gc_currently_forbidden = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 tmp = call2 (pred, obj1, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 if (NILP (tmp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 DEFUN ("sort", Fsort, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 Sort LIST, stably, comparing elements using PREDICATE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 Returns the sorted list. LIST is modified by side effects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 PREDICATE is called with two elements of LIST, and should return T
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 if the first element is "less" than the second.
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 (list, predicate))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1751 return list_sort (list, predicate, merge_pred_function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 }
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 merge (Lisp_Object org_l1, Lisp_Object org_l2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 Lisp_Object pred)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 return list_merge (org_l1, org_l2, pred, merge_pred_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 Lisp_Object lisp_arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 int (*pred_fn) (Lisp_Object, Lisp_Object, Lisp_Object lisp_arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 Lisp_Object value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 Lisp_Object l1, l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 l1 = org_l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 l2 = org_l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 value = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 /* It is sufficient to protect org_l1 and org_l2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 When l1 and l2 are updated, we copy the new values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 back into the org_ vars. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 GCPRO4 (org_l1, org_l2, lisp_arg, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 if (NILP (l1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 return l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 Fsetcdr (tail, l2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 if (NILP (l2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 return l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 Fsetcdr (tail, l1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 return value;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 if (((*pred_fn) (Fcar (l2), Fcar (l1), lisp_arg)) < 0)
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 tem = l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 l1 = Fcdr (l1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 org_l1 = l1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 tem = l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 l2 = Fcdr (l2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 org_l2 = l2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 value = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 Fsetcdr (tail, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 tail = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 /* property-list functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 /* For properties of text, we need to do order-insensitive comparison of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 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
1830 same if they have the same set of keys, and equivalent values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 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
1832
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 NIL_MEANS_NOT_PRESENT is as in `plists-eq' etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 LAXP means use `equal' for comparisons.
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 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
1838 int laxp, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
1840 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
1841 int la, lb, m, i, fill;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 Lisp_Object *keys, *vals;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 char *flags;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 if (NILP (a) && NILP (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 Fcheck_valid_plist (a);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 Fcheck_valid_plist (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 la = XINT (Flength (a));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 lb = XINT (Flength (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 m = (la > lb ? la : lb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 fill = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 keys = alloca_array (Lisp_Object, m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 vals = alloca_array (Lisp_Object, m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 flags = alloca_array (char, m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 /* First extract the pairs from A. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 for (rest = a; !NILP (rest); rest = XCDR (XCDR (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 Lisp_Object k = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 Lisp_Object v = XCAR (XCDR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 /* Maybe be Ebolified. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 if (nil_means_not_present && NILP (v)) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 keys [fill] = k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 vals [fill] = v;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 flags[fill] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 fill++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 /* 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
1873 or that doesn't match. As we match, mark them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 for (rest = b; !NILP (rest); rest = XCDR (XCDR (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 Lisp_Object k = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 Lisp_Object v = XCAR (XCDR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 /* Maybe be Ebolified. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 if (nil_means_not_present && NILP (v)) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 for (i = 0; i < fill; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1884 if (eqp
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1885 /* We narrowly escaped being Ebolified here. */
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1886 ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1887 : !internal_equal (v, vals [i], depth))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 /* a property in B has a different value than in A */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 goto MISMATCH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 flags [i] = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 if (i == fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 /* there are some properties in B that are not in A */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 goto MISMATCH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 /* 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
1899 for (i = 0; i < fill; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 if (flags [i] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 goto MISMATCH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 /* Ok. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 MISMATCH:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 return 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 DEFUN ("plists-eq", Fplists_eq, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 Return non-nil if property lists A and B are `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 A property list is an alternating list of keywords and values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 This function does order-insensitive comparisons of the property lists:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 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
1915 Comparison between values is done using `eq'. See also `plists-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 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
1917 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
1918 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 (a, b, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 DEFUN ("plists-equal", Fplists_equal, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 Return non-nil if property lists A and B are `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 A property list is an alternating list of keywords and values. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 function does order-insensitive comparisons of the property lists: For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 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
1932 Comparison between values is done using `equal'. See also `plists-eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 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
1934 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
1935 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 compatibility.
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 (a, b, nil_means_not_present))
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 return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 DEFUN ("lax-plists-eq", Flax_plists_eq, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 Return non-nil if lax property lists A and B are `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 A property list is an alternating list of keywords and values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 This function does order-insensitive comparisons of the property lists:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 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
1950 Comparison between values is done using `eq'. See also `plists-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 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
1952 keywords is done using `equal' instead of `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 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
1954 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
1955 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 (a, b, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 DEFUN ("lax-plists-equal", Flax_plists_equal, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 Return non-nil if lax property lists A and B are `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 A property list is an alternating list of keywords and values. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 function does order-insensitive comparisons of the property lists: For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 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
1969 Comparison between values is done using `equal'. See also `plists-eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 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
1971 keywords is done using `equal' instead of `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 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
1973 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
1974 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 (a, b, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 ? Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 /* Return the value associated with key PROPERTY in property list PLIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 Return nil if key not found. This function is used for internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 property lists that cannot be directly manipulated by the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 internal_plist_get (Lisp_Object plist, Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 for (tail = plist; !NILP (tail); tail = XCDR (XCDR (tail)))
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 (EQ (XCAR (tail), property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 return XCAR (XCDR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 /* Set PLIST's value for PROPERTY to VALUE. Analogous to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 internal_plist_get(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 internal_plist_put (Lisp_Object *plist, Lisp_Object property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 Lisp_Object tail;
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 for (tail = *plist; !NILP (tail); tail = XCDR (XCDR (tail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 if (EQ (XCAR (tail), property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 XCAR (XCDR (tail)) = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 *plist = Fcons (property, Fcons (value, *plist));
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 internal_remprop (Lisp_Object *plist, Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 Lisp_Object tail, prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 for (tail = *plist, prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 !NILP (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 tail = XCDR (XCDR (tail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 if (EQ (XCAR (tail), property))
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 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 *plist = XCDR (XCDR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 XCDR (XCDR (prev)) = XCDR (XCDR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 return 1;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 /* Called on a malformed property list. BADPLACE should be some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 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
2049 result in a list with an odd length. */
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 static Lisp_Object
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2052 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
2053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 if (ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 return Fsignal (Qmalformed_property_list, list2 (*plist, *badplace));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 else
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 if (ERRB_EQ (errb, ERROR_ME_WARN))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 warn_when_safe_lispobj
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 (Qlist, Qwarning,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 list2 (build_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 ("Malformed property list -- list has been truncated"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 *plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 *badplace = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 }
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 /* Called on a circular property list. BADPLACE should be some place
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 where truncating will result in an even-length list, as above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 If doesn't particularly matter where we truncate -- anywhere we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 truncate along the entire list will break the circularity, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 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
2076 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 static Lisp_Object
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2079 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
2080 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 if (ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 return Fsignal (Qcircular_property_list, list1 (*plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 if (ERRB_EQ (errb, ERROR_ME_WARN))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 warn_when_safe_lispobj
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 (Qlist, Qwarning,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 list2 (build_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 ("Circular property list -- list has been truncated"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 *plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 *badplace = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 return Qunbound;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 /* Advance the tortoise pointer by two (one iteration of a property-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 loop) and the hare pointer by four and verify that no malformations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 or circularities exist. If so, return zero and store a value into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 RETVAL that should be returned by the calling function. Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 return 1. See external_plist_get().
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 advance_plist_pointers (Lisp_Object *plist,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 Lisp_Object **tortoise, Lisp_Object **hare,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 575
diff changeset
2108 Error_Behavior errb, Lisp_Object *retval)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 Lisp_Object *tortsave = *tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 /* Note that our "fixing" may be more brutal than necessary,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 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
2115 manually fucked up a plist. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 for (i = 0; i < 2; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 /* This is a standard iteration of a defensive-loop-checking
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 loop. We just do it twice because we want to advance past
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 both the property and its value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 If the pointer indirection is confusing you, remember that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 one level of indirection on the hare and tortoise pointers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 is only due to pass-by-reference for this function. The other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 level is so that the plist can be fixed in place. */
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 /* When we reach the end of a well-formed plist, **HARE is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 nil. In that case, we don't do anything at all except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 advance TORTOISE by one. Otherwise, we advance HARE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 by two (making sure it's OK to do so), then advance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 TORTOISE by one (it will always be OK to do so because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 the HARE is always ahead of the TORTOISE and will have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 already verified the path), then make sure TORTOISE and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 HARE don't contain the same non-nil object -- if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 TORTOISE and the HARE ever meet, then obviously we're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 in a circularity, and if we're in a circularity, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 the TORTOISE and the HARE can't cross paths without
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 meeting, since the HARE only gains one step over the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 TORTOISE per iteration. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 if (!NILP (**hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 Lisp_Object *haresave = *hare;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 if (!CONSP (**hare))
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 *retval = bad_bad_bunny (plist, haresave, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 *hare = &XCDR (**hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 /* 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
2152 **HARE, which is OK (it just means the list has an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 odd number of elements). In a plist, it's not OK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 for the list to have an odd number of elements. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 if (!CONSP (**hare))
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 *retval = bad_bad_bunny (plist, haresave, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 return 0;
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 *hare = &XCDR (**hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 *tortoise = &XCDR (**tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 if (!NILP (**hare) && EQ (**tortoise, **hare))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 *retval = bad_bad_turtle (plist, tortsave, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 }
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 return 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 /* Return the value of PROPERTY from PLIST, or Qunbound if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 property is not on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 PLIST is a Lisp-accessible property list, meaning that it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 has to be checked for malformations and circularities.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 If ERRB is ERROR_ME, an error will be signalled. Otherwise, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 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
2182 on finding a malformation or a circularity, it issues a warning and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 attempts to silently fix the problem.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 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
2186 "fixed" even if the error is at the beginning of the plist. */
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 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
2190 int laxp, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 Lisp_Object *tortoise = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 Lisp_Object *hare = plist;
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 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 Lisp_Object *tortsave = tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 /* We do the standard tortoise/hare march. We isolate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 grungy stuff to do this in advance_plist_pointers(), though.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 To us, all this function does is advance the tortoise
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 pointer by two and the hare pointer by four and make sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 everything's OK. We first advance the pointers and then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 check if a property matched; this ensures that our
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 check for a matching property is safe. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 if (!laxp ? EQ (XCAR (*tortsave), property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 : internal_equal (XCAR (*tortsave), property, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 return XCAR (XCDR (*tortsave));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 return Qunbound;
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 /* Set PLIST's value for PROPERTY to VALUE, given a possibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 malformed or circular plist. Analogous to external_plist_get(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 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
2224 Lisp_Object value, int laxp, Error_Behavior errb)
428
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 Lisp_Object *tortoise = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 Lisp_Object *hare = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 while (!NILP (*tortoise))
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 Lisp_Object *tortsave = tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 Lisp_Object retval;
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 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 return;
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 if (!laxp ? EQ (XCAR (*tortsave), property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 : internal_equal (XCAR (*tortsave), property, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 XCAR (XCDR (*tortsave)) = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 return;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 *plist = Fcons (property, Fcons (value, *plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 }
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 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
2251 int laxp, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 Lisp_Object *tortoise = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 Lisp_Object *hare = plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 Lisp_Object *tortsave = tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 return 0;
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 if (!laxp ? EQ (XCAR (*tortsave), property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 : internal_equal (XCAR (*tortsave), property, 0))
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 /* Now you see why it's so convenient to have that level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 of indirection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 *tortsave = XCDR (XCDR (*tortsave));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 }
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 DEFUN ("plist-get", Fplist_get, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 Extract a value from a property list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 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
2281 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...).
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2282 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2283 This function returns the value corresponding to the PROPERTY,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2284 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
2285 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2286 (plist, property, default_))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2288 Lisp_Object value = external_plist_get (&plist, property, 0, ERROR_ME);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2289 return UNBOUNDP (value) ? default_ : value;
428
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 DEFUN ("plist-put", Fplist_put, 3, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2293 Change value in PLIST of PROPERTY to VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2294 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
2295 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...).
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2296 PROPERTY is usually a symbol and VALUE is any object.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2297 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
2298 otherwise the new PROPERTY VALUE pair is added.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2299 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
2300 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
2301 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2302 (plist, property, value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2304 external_plist_put (&plist, property, value, 0, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 return plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2309 Remove from PLIST the property PROPERTY and its value.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2310 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
2311 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...).
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2312 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2313 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
2314 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
2315 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2316 (plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2318 external_remprop (&plist, property, 0, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 return plist;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 DEFUN ("plist-member", Fplist_member, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2323 Return t if PROPERTY has a value specified in PLIST.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2325 (plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2327 Lisp_Object value = Fplist_get (plist, property, Qunbound);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2328 return UNBOUNDP (value) ? Qnil : Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 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
2333 This means that it's a malformed or circular plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 (plist))
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 Lisp_Object *tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 Lisp_Object *hare;
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 start_over:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 tortoise = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 hare = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 while (!NILP (*tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 Lisp_Object retval;
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 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 goto start_over;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 Given a plist, return non-nil if its format is correct.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 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
2359 the plist; that means it's a malformed or circular plist.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 (plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 Lisp_Object *tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 Lisp_Object *hare;
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 tortoise = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 hare = &plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 while (!NILP (*tortoise))
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 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 /* See above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME_NOT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 &retval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 DEFUN ("canonicalize-plist", Fcanonicalize_plist, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 Destructively remove any duplicate entries from a plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 In such cases, the first entry applies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 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
2386 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
2387 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 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
2391 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
2392 `setq' the value back into where it came from.
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 (plist, nil_means_not_present))
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 Lisp_Object head = plist;
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 Fcheck_valid_plist (plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 while (!NILP (plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 Lisp_Object prop = Fcar (plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 Lisp_Object next = Fcdr (plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 CHECK_CONS (next); /* just make doubly sure we catch any errors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 if (!NILP (nil_means_not_present) && NILP (Fcar (next)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 if (EQ (head, plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 head = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 plist = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 continue;
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 /* external_remprop returns 1 if it removed any property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 We have to loop till it didn't remove anything, in case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 the property occurs many times. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 while (external_remprop (&XCDR (next), prop, 0, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 DO_NOTHING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 plist = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 return head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 Extract a value from a lax property list.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2426 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
2427 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2428 properties is done using `equal' instead of `eq'.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2429 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2430 This function returns the value corresponding to PROPERTY,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2431 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
2432 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2433 (lax_plist, property, default_))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2435 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
2436 return UNBOUNDP (value) ? default_ : value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2440 Change value in LAX-PLIST of PROPERTY to VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2441 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
2442 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2443 properties is done using `equal' instead of `eq'.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2444 PROPERTY is usually a symbol and VALUE is any object.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2445 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
2446 VALUE, otherwise the new PROPERTY VALUE pair is added.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2447 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
2448 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
2449 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2450 (lax_plist, property, value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2452 external_plist_put (&lax_plist, property, value, 1, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 return lax_plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 }
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 DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2457 Remove from LAX-PLIST the property PROPERTY and its value.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2458 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
2459 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2460 properties is done using `equal' instead of `eq'.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2461 PROPERTY is usually a symbol.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2462 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
2463 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
2464 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2465 (lax_plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2467 external_remprop (&lax_plist, property, 1, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 return lax_plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2472 Return t if PROPERTY has a value specified in LAX-PLIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2473 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
2474 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2475 properties is done using `equal' instead of `eq'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2477 (lax_plist, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2479 return UNBOUNDP (Flax_plist_get (lax_plist, property, Qunbound)) ? Qnil : Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 }
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 DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 Destructively remove any duplicate entries from a lax plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 In such cases, the first entry applies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 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
2487 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
2488 old Lisp implementations, but should not be used except for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 compatibility.
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 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
2492 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
2493 `setq' the value back into where it came from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 (lax_plist, nil_means_not_present))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 Lisp_Object head = lax_plist;
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 Fcheck_valid_plist (lax_plist);
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 while (!NILP (lax_plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 Lisp_Object prop = Fcar (lax_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 Lisp_Object next = Fcdr (lax_plist);
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 CHECK_CONS (next); /* just make doubly sure we catch any errors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 if (!NILP (nil_means_not_present) && NILP (Fcar (next)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 if (EQ (head, lax_plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 head = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 lax_plist = Fcdr (next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 /* external_remprop returns 1 if it removed any property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 We have to loop till it didn't remove anything, in case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 the property occurs many times. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 while (external_remprop (&XCDR (next), prop, 1, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 DO_NOTHING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 lax_plist = Fcdr (next);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 return head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 /* In C because the frame props stuff uses it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 DEFUN ("destructive-alist-to-plist", Fdestructive_alist_to_plist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 Convert association list ALIST into the equivalent property-list form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 The plist is returned. This converts from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 \((a . 1) (b . 2) (c . 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 \(a 1 b 2 c 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 The original alist is destroyed in the process of constructing the plist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 See also `alist-to-plist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 (alist))
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 Lisp_Object head = alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 while (!NILP (alist))
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 /* remember the alist element. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 Lisp_Object el = Fcar (alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 Fsetcar (alist, Fcar (el));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 Fsetcar (el, Fcdr (el));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 Fsetcdr (el, Fcdr (alist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 Fsetcdr (alist, el);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 alist = Fcdr (Fcdr (alist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 return head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 DEFUN ("get", Fget, 2, 3, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2559 Return the value of OBJECT's PROPERTY property.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2560 This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 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
2562 \(which defaults to `nil'). OBJECT can be a symbol, string, extent,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2563 face, or glyph. See also `put', `remprop', and `object-plist'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2565 (object, property, default_))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 /* Various places in emacs call Fget() and expect it not to quit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 so don't quit. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2569 Lisp_Object val;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2570
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2571 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->getprop)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2572 val = XRECORD_LHEADER_IMPLEMENTATION (object)->getprop (object, property);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2574 invalid_operation ("Object type has no properties", object);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2575
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2576 return UNBOUNDP (val) ? default_ : val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 DEFUN ("put", Fput, 3, 3, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2580 Set OBJECT's PROPERTY to VALUE.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2581 It can be subsequently retrieved with `(get OBJECT PROPERTY)'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2582 OBJECT can be a symbol, face, extent, or string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 For a string, no properties currently have predefined meanings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 For the predefined properties for extents, see `set-extent-property'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 For the predefined properties for faces, see `set-face-property'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 See also `get', `remprop', and `object-plist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2588 (object, property, value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 CHECK_LISP_WRITEABLE (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2592 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->putprop)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2594 if (! XRECORD_LHEADER_IMPLEMENTATION (object)->putprop
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2595 (object, property, value))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2596 invalid_change ("Can't set property on object", property);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2599 invalid_change ("Object type has no settable properties", object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 return value;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 DEFUN ("remprop", Fremprop, 2, 2, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2605 Remove, from OBJECT's property list, PROPERTY and its corresponding value.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2606 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
2607 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
2608 in the property list). See also `get', `put', and `object-plist'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2610 (object, property))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2612 int ret = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2613
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 CHECK_LISP_WRITEABLE (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2616 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->remprop)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2618 ret = XRECORD_LHEADER_IMPLEMENTATION (object)->remprop (object, property);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2619 if (ret == -1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2620 invalid_change ("Can't remove property from object", property);
428
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 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2623 invalid_change ("Object type has no removable properties", object);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2624
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2625 return ret ? Qt : Qnil;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2629 Return a property list of OBJECT's properties.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2630 For a symbol, this is equivalent to `symbol-plist'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2631 OBJECT can be a symbol, string, extent, face, or glyph.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2632 Do not modify the returned property list directly;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2633 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
2634 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2637 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->plist)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2638 return XRECORD_LHEADER_IMPLEMENTATION (object)->plist (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2640 invalid_operation ("Object type has no properties", object);
428
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 }
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 internal_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 if (depth > 200)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2650 stack_overflow ("Stack overflow in equal", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 /* Note that (equal 20 20.0) should be nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 if (XTYPE (obj1) != XTYPE (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 if (LRECORDP (obj1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2659 const struct lrecord_implementation
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
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 return (imp1 == imp2) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 /* EQ-ness of the objects was noticed above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 (imp1->equal && (imp1->equal) (obj1, obj2, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 /* Note that we may be calling sub-objects that will use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 internal_equal() (instead of internal_old_equal()). Oh well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 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
2674 but that seems unlikely. */
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
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 if (depth > 200)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
2680 stack_overflow ("Stack overflow in equal", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 if (HACKEQ_UNSAFE (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 /* Note that (equal 20 20.0) should be nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 if (XTYPE (obj1) != XTYPE (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 return 0;
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 return internal_equal (obj1, obj2, depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 DEFUN ("equal", Fequal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 Return t if two Lisp objects have similar structure and contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 They must have the same data type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 Conses are compared by comparing the cars and the cdrs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 Vectors and strings are compared element by element.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 Numbers are compared by value. Symbols must match exactly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2698 (object1, object2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2700 return internal_equal (object1, object2, 0) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 DEFUN ("old-equal", Fold_equal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 Return t if two Lisp objects have similar structure and contents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 They must have the same data type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 \(Note, however, that an exception is made for characters and integers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 this is known as the "char-int confoundance disease." See `eq' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 `old-eq'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 This function is provided only for byte-code compatibility with v19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 Do not use it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2712 (object1, object2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2714 return internal_old_equal (object1, object2, 0) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 DEFUN ("fillarray", Ffillarray, 2, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2719 Destructively modify ARRAY by replacing each element with ITEM.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 ARRAY is a vector, bit vector, or string.
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 (array, item))
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 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 if (STRINGP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2727 Lisp_String *s = XSTRING (array);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2728 Bytecount old_bytecount = string_length (s);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2729 Bytecount new_bytecount;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2730 Bytecount item_bytecount;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2731 Intbyte item_buf[MAX_EMCHAR_LEN];
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2732 Intbyte *p;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2733 Intbyte *end;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2734
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 CHECK_CHAR_COERCE_INT (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 CHECK_LISP_WRITEABLE (array);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2737
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2738 item_bytecount = set_charptr_emchar (item_buf, XCHAR (item));
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2739 new_bytecount = item_bytecount * string_char_length (s);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2740
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2741 resize_string (s, -1, new_bytecount - old_bytecount);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2742
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2743 for (p = string_data (s), end = p + new_bytecount;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2744 p < end;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2745 p += item_bytecount)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2746 memcpy (p, item_buf, item_bytecount);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2747 *p = '\0';
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2748
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 bump_string_modiff (array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 else if (VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 Lisp_Object *p = XVECTOR_DATA (array);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2754 Elemcount len = XVECTOR_LENGTH (array);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 CHECK_LISP_WRITEABLE (array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 while (len--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 *p++ = item;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 else if (BIT_VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2761 Lisp_Bit_Vector *v = XBIT_VECTOR (array);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2762 Elemcount len = bit_vector_length (v);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 int bit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 CHECK_BIT (item);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2765 bit = XINT (item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 CHECK_LISP_WRITEABLE (array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 while (len--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 set_bit_vector_bit (v, len, bit);
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 array = wrong_type_argument (Qarrayp, array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 return array;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 nconc2 (Lisp_Object arg1, Lisp_Object arg2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 Lisp_Object args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 args[0] = arg1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 args[1] = arg2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 GCPRO1 (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 gcpro1.nvars = 2;
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_UNGCPRO (bytecode_nconc2 (args));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 bytecode_nconc2 (Lisp_Object *args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 if (CONSP (args[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 /* (setcdr (last args[0]) args[1]) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 Lisp_Object tortoise, hare;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2801 Elemcount count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 for (hare = tortoise = args[0], count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 CONSP (XCDR (hare));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 hare = XCDR (hare), count++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 if (count & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 if (EQ (hare, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 signal_circular_list_error (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 XCDR (hare) = args[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 return args[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 else if (NILP (args[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 return args[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 args[0] = wrong_type_argument (args[0], Qlistp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 DEFUN ("nconc", Fnconc, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 Concatenate any number of lists by altering them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 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
2831 Also see: `append'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 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
2833 effect; therefore, write `(setq foo (nconc foo list))' to be sure of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 changing the value of `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 int argnum = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 struct gcpro gcpro1;
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 /* The modus operandi in Emacs is "caller gc-protects args".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 However, nconc (particularly nconc2 ()) is called many times
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 in Emacs on freshly created stuff (e.g. you see the idiom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 nconc2 (Fcopy_sequence (foo), bar) a lot). So we help those
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 callers out by protecting the args ourselves to save them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 a lot of temporary-variable grief. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 GCPRO1 (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 gcpro1.nvars = nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 while (argnum < nargs)
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 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 val = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 if (CONSP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 /* `val' is the first cons, which will be our return value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 /* `last_cons' will be the cons cell to mutate. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 Lisp_Object last_cons = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 Lisp_Object tortoise = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 for (argnum++; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 Lisp_Object next = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 retry_next:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 if (CONSP (next) || argnum == nargs -1)
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 /* (setcdr (last val) next) */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2870 Elemcount count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 for (count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 CONSP (XCDR (last_cons));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 last_cons = XCDR (last_cons), count++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 if (count & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 if (EQ (last_cons, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 signal_circular_list_error (args[argnum-1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 XCDR (last_cons) = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 else if (NILP (next))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 next = wrong_type_argument (Qlistp, next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 goto retry_next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 RETURN_UNGCPRO (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 else if (NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 argnum++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899 else if (argnum == nargs - 1) /* last arg? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 RETURN_UNGCPRO (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 args[argnum] = wrong_type_argument (Qlistp, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 }
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 RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2911 /* This is the guts of several mapping functions.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2912 Apply FUNCTION to each element of SEQUENCE, one by one,
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2913 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
2914 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
2915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 If VALS is a null pointer, do not accumulate the results. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 static void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2919 mapcar1 (Elemcount leni, Lisp_Object *vals,
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2920 Lisp_Object function, Lisp_Object sequence)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 Lisp_Object args[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 struct gcpro gcpro1;
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 if (vals)
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 GCPRO1 (vals[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 gcpro1.nvars = 0;
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
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2932 args[0] = function;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2933
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2934 if (LISTP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2936 /* A devious `function' could either:
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2937 - 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
2938 - amputate the list behind us using (setcdr), causing the remaining
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2939 elts to lose their GCPRO status.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2940
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2941 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
2942 `vals' array. By a stroke of luck, `vals' is exactly large
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2943 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
2944 results computed so far.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2945
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2946 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
2947 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
2948 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
2949
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2950 if (vals)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2952 Lisp_Object *val = vals;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2953 Elemcount i;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2954
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2955 LIST_LOOP_2 (elt, sequence)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2956 *val++ = elt;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2957
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2958 gcpro1.nvars = leni;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2959
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2960 for (i = 0; i < leni; i++)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2961 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2962 args[1] = vals[i];
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2963 vals[i] = Ffuncall (2, args);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2964 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2965 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2966 else
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2967 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2968 Lisp_Object elt, tail;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2969 EMACS_INT len_unused;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2970 struct gcpro ngcpro1;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2971
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2972 NGCPRO1 (tail);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2973
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2974 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2975 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
2976 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2977 args[1] = elt;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2978 Ffuncall (2, args);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2979 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2980 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2981
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2982 NUNGCPRO;
428
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 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2985 else if (VECTORP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2987 Lisp_Object *objs = XVECTOR_DATA (sequence);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2988 Elemcount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 for (i = 0; i < leni; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 args[1] = *objs++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 result = Ffuncall (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 if (vals) vals[gcpro1.nvars++] = result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2996 else if (STRINGP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2998 /* The string data of `sequence' might be relocated during GC. */
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2999 Bytecount slen = XSTRING_LENGTH (sequence);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3000 Intbyte *p = alloca_array (Intbyte, slen);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3001 Intbyte *end = p + slen;
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3002
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3003 memcpy (p, XSTRING_DATA (sequence), slen);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3004
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3005 while (p < end)
428
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 args[1] = make_char (charptr_emchar (p));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 INC_CHARPTR (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 result = Ffuncall (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 if (vals) vals[gcpro1.nvars++] = result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3013 else if (BIT_VECTORP (sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3015 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3016 Elemcount i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 for (i = 0; i < leni; i++)
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 args[1] = make_int (bit_vector_bit (v, i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 result = Ffuncall (2, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 if (vals) vals[gcpro1.nvars++] = result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3025 abort (); /* unreachable, since Flength (sequence) did not get an error */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 if (vals)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3032 Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3033 In between each pair of results, insert SEPARATOR. Thus, using " " as
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3034 SEPARATOR results in spaces between the values returned by FUNCTION.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3035 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
3036 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3037 (function, sequence, separator))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3039 EMACS_INT len = XINT (Flength (sequence));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 Lisp_Object *args;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3041 EMACS_INT i;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3042 EMACS_INT nargs = len + len - 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3044 if (len == 0) return build_string ("");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 args = alloca_array (Lisp_Object, nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3048 mapcar1 (len, args, function, sequence);
428
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 for (i = len - 1; i >= 0; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 args[i + i] = args[i];
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 for (i = 1; i < nargs; i += 2)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3054 args[i] = separator;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 return Fconcat (nargs, args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 }
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 DEFUN ("mapcar", Fmapcar, 2, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3060 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
3061 The result is a list of the same length as SEQUENCE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 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
3063 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3064 (function, sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3066 Elemcount len = XINT (Flength (sequence));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 Lisp_Object *args = alloca_array (Lisp_Object, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3069 mapcar1 (len, args, function, sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
3071 return Flist ((int) len, args);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 }
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 DEFUN ("mapvector", Fmapvector, 2, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3075 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
3076 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
3077 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
3078 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3079 (function, sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3081 Elemcount len = XINT (Flength (sequence));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 Lisp_Object result = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 GCPRO1 (result);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3086 mapcar1 (len, XVECTOR_DATA (result), function, sequence);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 Apply FUNCTION to each element of SEQUENCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 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
3095 This function is like `mapcar' but does not accumulate the results,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 which is more efficient if you do not use the results.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 The difference between this and `mapc' is that `mapc' supports all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 the spiffy Common Lisp arguments. You should normally use `mapc'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 */
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3101 (function, sequence))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3103 mapcar1 (XINT (Flength (sequence)), 0, function, sequence);
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3104
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
3105 return sequence;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3109
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3110
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3111 DEFUN ("replace-list", Freplace_list, 2, 2, 0, /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3112 Destructively replace the list OLD with NEW.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3113 This is like (copy-sequence NEW) except that it reuses the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3114 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
3115 length, no consing will take place.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3116 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3117 (old, new))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3118 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3119 Lisp_Object tail, oldtail = old, prevoldtail = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3120
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3121 EXTERNAL_LIST_LOOP (tail, new)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3122 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3123 if (!NILP (oldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3124 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3125 CHECK_CONS (oldtail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3126 XCAR (oldtail) = XCAR (tail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3127 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3128 else if (!NILP (prevoldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3129 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3130 XCDR (prevoldtail) = Fcons (XCAR (tail), Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3131 prevoldtail = XCDR (prevoldtail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3132 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3133 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3134 old = oldtail = Fcons (XCAR (tail), Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3135
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3136 if (!NILP (oldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3137 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3138 prevoldtail = oldtail;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3139 oldtail = XCDR (oldtail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3140 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3141 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3142
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3143 if (!NILP (prevoldtail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3144 XCDR (prevoldtail) = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3145 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3146 old = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3147
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3148 return old;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3149 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3150
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3151
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 /* #### this function doesn't belong in this file! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3154 #ifdef HAVE_GETLOADAVG
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3155 #ifdef HAVE_SYS_LOADAVG_H
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3156 #include <sys/loadavg.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3157 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3158 #else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3159 int getloadavg (double loadavg[], int nelem); /* Defined in getloadavg.c */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3160 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3161
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 DEFUN ("load-average", Fload_average, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 Return list of 1 minute, 5 minute and 15 minute load averages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 Each of the three load averages is multiplied by 100,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 then converted to integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 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
3168 These floats are not multiplied by 100.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 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
3171 shortened list, containing only those averages which are available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 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
3174 in which case you can't use this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 (use_floats))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 double load_ave[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 int loads = getloadavg (load_ave, countof (load_ave));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 Lisp_Object ret = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 if (loads == -2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3183 signal_error (Qunimplemented,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3184 "load-average not implemented for this operating system",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3185 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 else if (loads < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3187 invalid_operation ("Could not get load-average", lisp_strerror (errno));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 while (loads-- > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 Lisp_Object load = (NILP (use_floats) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 make_int ((int) (100.0 * load_ave[loads]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 : make_float (load_ave[loads]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 ret = Fcons (load, ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 Lisp_Object Vfeatures;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 Return non-nil if feature FEXP is present in this Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 Use this to conditionalize execution of lisp code based on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 presence or absence of emacs or environment extensions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 FEXP can be a symbol, a number, or a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 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
3208 and non-nil will be returned if found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 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
3210 has an equal or greater version number than FEXP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 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
3212 non-nil if all the features in its cdr are non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 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
3214 if any of the features in its cdr are non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 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
3216 non-nil if the feature is not present.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 Examples:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 (featurep 'xemacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 => ; Non-nil on XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 (featurep '(and xemacs gnus))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 => ; Non-nil on XEmacs with Gnus loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 (featurep '(or tty-frames (and emacs 19.30)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 => ; Non-nil if this Emacs supports TTY frames.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 (featurep '(or (and xemacs 19.15) (and emacs 19.34)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 => ; 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
3231
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3232 (featurep '(and xemacs 21.02))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3233 => ; Non-nil on XEmacs 21.2 and later.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3234
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 NOTE: The advanced arguments of this function (anything other than a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 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
3237 for supporting multiple Emacs variants, lobby Richard Stallman at
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3238 <bug-gnu-emacs@gnu.org>.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 (fexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 #ifndef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 CHECK_SYMBOL (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 #else /* FEATUREP_SYNTAX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 static double featurep_emacs_version;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 /* Brute force translation from Erik Naggum's lisp function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 if (SYMBOLP (fexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 /* Original definition */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 else if (INTP (fexp) || FLOATP (fexp))
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 double d = extract_float (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 if (featurep_emacs_version == 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 featurep_emacs_version = XINT (Vemacs_major_version) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 (XINT (Vemacs_minor_version) / 100.0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 return featurep_emacs_version >= d ? Qt : Qnil;
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 else if (CONSP (fexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 Lisp_Object tem = XCAR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 if (EQ (tem, Qnot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 Lisp_Object negate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 tem = XCDR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 negate = Fcar (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 return NILP (call1 (Qfeaturep, negate)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 return Fsignal (Qinvalid_read_syntax, list1 (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 else if (EQ (tem, Qand))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 tem = XCDR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 /* Use Fcar/Fcdr for error-checking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 while (!NILP (tem) && !NILP (call1 (Qfeaturep, Fcar (tem))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 tem = Fcdr (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 return NILP (tem) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 else if (EQ (tem, Qor))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 tem = XCDR (fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 /* Use Fcar/Fcdr for error-checking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 while (!NILP (tem) && NILP (call1 (Qfeaturep, Fcar (tem))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 tem = Fcdr (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 return NILP (tem) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 return Fsignal (Qinvalid_read_syntax, list1 (XCDR (fexp)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 return Fsignal (Qinvalid_read_syntax, list1 (fexp));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 #endif /* FEATUREP_SYNTAX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 DEFUN ("provide", Fprovide, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 Announce that FEATURE is a feature of the current Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 This function updates the value of the variable `features'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 (feature))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 CHECK_SYMBOL (feature);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 if (!NILP (Vautoload_queue))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321 tem = Fmemq (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 Vfeatures = Fcons (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 LOADHIST_ATTACH (Fcons (Qprovide, feature));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 return feature;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 DEFUN ("require", Frequire, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 If feature FEATURE is not loaded, load it from FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 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
3331 is not loaded; so load the file FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 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
3333 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3334 (feature, filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 CHECK_SYMBOL (feature);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 tem = Fmemq (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 LOADHIST_ATTACH (Fcons (Qrequire, feature));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 return feature;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 else
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 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 /* Value saved here is to be restored into Vautoload_queue */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 record_unwind_protect (un_autoload, Vautoload_queue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 Vautoload_queue = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3350 call4 (Qload, NILP (filename) ? Fsymbol_name (feature) : filename,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 Qnil, Qt, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 tem = Fmemq (feature, Vfeatures);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 if (NILP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3355 invalid_state ("Required feature was not provided", feature);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 /* Once loading finishes, don't undo it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 Vautoload_queue = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 return unbind_to (speccount, feature);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 }
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 /* base64 encode/decode functions.
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 Originally based on code from GNU recode. Ported to FSF Emacs by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 Lars Magne Ingebrigtsen and Karl Heuer. Ported to XEmacs and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 subsequently heavily hacked by Hrvoje Niksic. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 #define MIME_LINE_LENGTH 72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 #define IS_ASCII(Character) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 ((Character) < 128)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 #define IS_BASE64(Character) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 (IS_ASCII (Character) && base64_char_to_value[Character] >= 0)
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 /* Table of characters coding the 64 values. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 static char base64_value_to_char[64] =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', /* 20-29 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', /* 30-39 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', /* 40-49 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', /* 50-59 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 '8', '9', '+', '/' /* 60-63 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 /* Table of base64 values for first 128 characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 static short base64_char_to_value[128] =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 /* The following diagram shows the logical steps by which three octets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 get transformed into four base64 characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 .--------. .--------. .--------.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 |aaaaaabb| |bbbbcccc| |ccdddddd|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 `--------' `--------' `--------'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 6 2 4 4 2 6
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 |00aaaaaa|00bbbbbb|00cccccc|00dddddd|
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 .--------+--------+--------+--------.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 `--------+--------+--------+--------'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 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
3422 base64 characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423
575
d5e8f5ad5043 [xemacs-hg @ 2001-05-25 04:22:31 by martinb]
martinb
parents: 563
diff changeset
3424 static DOESNT_RETURN
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3425 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
3426 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3427 signal_error (Qbase64_conversion_error, reason, frob);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3428 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3429
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3430 #define ADVANCE_INPUT(c, stream) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3431 ((ec = Lstream_get_emchar (stream)) == -1 ? 0 : \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3432 ((ec > 255) ? \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3433 (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
3434 make_char (ec)), 0) \
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3435 : (c = (Intbyte)ec), 1))
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3436
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3437 static Bytebpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3438 base64_encode_1 (Lstream *istream, Intbyte *to, int line_break)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 EMACS_INT counter = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3441 Intbyte *e = to;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 Emchar ec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 unsigned int value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3447 Intbyte c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 if (!ADVANCE_INPUT (c, istream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 /* Wrap line every 76 characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 if (line_break)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 if (counter < MIME_LINE_LENGTH / 4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 counter++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 *e++ = '\n';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 counter = 1;
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 }
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 /* Process first byte of a triplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 *e++ = base64_value_to_char[0x3f & c >> 2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 value = (0x03 & c) << 4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 /* Process second byte of a triplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 if (!ADVANCE_INPUT (c, istream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 *e++ = base64_value_to_char[value];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 *e++ = '=';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 *e++ = '=';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 *e++ = base64_value_to_char[value | (0x0f & c >> 4)];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 value = (0x0f & c) << 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 /* Process third byte of a triplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 if (!ADVANCE_INPUT (c, istream))
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 *e++ = base64_value_to_char[value];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 *e++ = '=';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 *e++ = base64_value_to_char[value | (0x03 & c >> 6)];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 *e++ = base64_value_to_char[0x3f & c];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 }
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 return e - to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 #undef ADVANCE_INPUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 /* Get next character from the stream, except that non-base64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 characters are ignored. This is in accordance with rfc2045. EC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 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
3498 #define ADVANCE_INPUT_IGNORE_NONBASE64(ec, stream, streampos) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 ec = Lstream_get_emchar (stream); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 ++streampos; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 /* IS_BASE64 may not be called with negative arguments so check for \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 EOF first. */ \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 if (ec < 0 || IS_BASE64 (ec) || ec == '=') \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 break; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 } while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 #define STORE_BYTE(pos, val, ccnt) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 ++ccnt; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3512 static Bytebpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3513 base64_decode_1 (Lstream *istream, Intbyte *to, Charcount *ccptr)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 Charcount ccnt = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3516 Intbyte *e = to;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 EMACS_INT streampos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 Emchar ec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 unsigned long value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 /* Process first byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 if (ec < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 if (ec == '=')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3529 base64_conversion_error ("Illegal `=' character while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3530 make_int (streampos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 value = base64_char_to_value[ec] << 18;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 /* Process second byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3536 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3537 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 if (ec == '=')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3539 base64_conversion_error ("Illegal `=' character while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3540 make_int (streampos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 value |= base64_char_to_value[ec] << 12;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 STORE_BYTE (e, value >> 16, ccnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 /* Process third byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3547 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3548 Qunbound);
428
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 if (ec == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3554 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3555 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 if (ec != '=')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3557 base64_conversion_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3558 ("Padding `=' expected but not found while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3559 make_int (streampos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 continue;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 value |= base64_char_to_value[ec] << 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 STORE_BYTE (e, 0xff & value >> 8, ccnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 /* Process fourth byte of a quadruplet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 if (ec < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3569 base64_conversion_error ("Premature EOF while decoding base64",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3570 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 if (ec == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 value |= base64_char_to_value[ec];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 STORE_BYTE (e, 0xff & value, ccnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 *ccptr = ccnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 return e - to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 #undef ADVANCE_INPUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 #undef ADVANCE_INPUT_IGNORE_NONBASE64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 #undef STORE_BYTE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 free_malloced_ptr (Lisp_Object unwind_obj)
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 void *ptr = (void *)get_opaque_ptr (unwind_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 xfree (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 free_opaque_ptr (unwind_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 }
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 /* Don't use alloca for regions larger than this, lest we overflow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 the stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 #define MAX_ALLOCA 65536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 /* We need to setup proper unwinding, because there is a number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 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
3600 leaks in those cases. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 #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
3602 Elemcount XOA_len = (len); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 if (XOA_len > MAX_ALLOCA) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 ptr = xnew_array (type, XOA_len); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 record_unwind_protect (free_malloced_ptr, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 make_opaque_ptr ((void *)ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 ptr = alloca_array (type, XOA_len); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 #define XMALLOC_UNBIND(ptr, len, speccount) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 if ((len) > MAX_ALLOCA) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 unbind_to (speccount, Qnil); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3619 Base64-encode the region between START and END.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 Return the length of the encoded text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 Optional third argument NO-LINE-BREAK means do not break long lines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 into shorter lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3624 (start, end, no_line_break))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3626 Intbyte *encoded;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3627 Bytebpos encoded_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 Charcount allength, length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 struct buffer *buf = current_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3630 Charbpos begv, zv, old_pt = BUF_PT (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 Lisp_Object input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3634 get_buffer_range_char (buf, start, end, &begv, &zv, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 barf_if_buffer_read_only (buf, begv, zv);
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 /* We need to allocate enough room for encoding the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 We need 33 1/3% more space, plus a newline every 76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 characters, and then we round up. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 length = zv - begv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 allength = length + length/3 + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 allength += allength / MIME_LINE_LENGTH + 1 + 6;
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 input = make_lisp_buffer_input_stream (buf, begv, zv, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 /* We needn't multiply allength with MAX_EMCHAR_LEN because all the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 base64 characters will be single-byte. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3647 XMALLOC_OR_ALLOCA (encoded, allength, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 encoded_length = base64_encode_1 (XLSTREAM (input), encoded,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 NILP (no_line_break));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650 if (encoded_length > allength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 /* Now we have encoded the region, so we insert the new contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 and delete the old. (Insert first in order to preserve markers.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 XMALLOC_UNBIND (encoded, allength, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0);
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 /* Simulate FSF Emacs implementation of this function: if point was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 in the region, place it at the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 if (old_pt >= begv && old_pt < zv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 BUF_SET_PT (buf, begv);
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 /* We return the length of the encoded text. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 return make_int (encoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 }
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 DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 Base64 encode STRING and return the result.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3671 Optional argument NO-LINE-BREAK means do not break long lines
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3672 into shorter lines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 (string, no_line_break))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 Charcount allength, length;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3677 Bytebpos encoded_length;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3678 Intbyte *encoded;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 Lisp_Object input, result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 length = XSTRING_CHAR_LENGTH (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 allength = length + length/3 + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 allength += allength / MIME_LINE_LENGTH + 1 + 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 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
3689 XMALLOC_OR_ALLOCA (encoded, allength, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 encoded_length = base64_encode_1 (XLSTREAM (input), encoded,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 NILP (no_line_break));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 if (encoded_length > allength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 result = make_string (encoded, encoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 XMALLOC_UNBIND (encoded, allength, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3701 Base64-decode the region between START and END.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 Return the length of the decoded text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 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
3704 Characters out of the base64 alphabet are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3706 (start, end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 struct buffer *buf = current_buffer;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3709 Charbpos begv, zv, old_pt = BUF_PT (buf);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3710 Intbyte *decoded;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3711 Bytebpos decoded_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 Charcount length, cc_decoded_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 Lisp_Object input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3716 get_buffer_range_char (buf, start, end, &begv, &zv, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 barf_if_buffer_read_only (buf, begv, zv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 length = zv - begv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 input = make_lisp_buffer_input_stream (buf, begv, zv, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 /* 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
3723 XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 if (decoded_length > length * MAX_EMCHAR_LEN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 /* Now we have decoded the region, so we insert the new contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 and delete the old. (Insert first in order to preserve markers.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 BUF_SET_PT (buf, begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 buffer_delete_range (buf, begv + cc_decoded_length,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 zv + cc_decoded_length, 0);
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 /* Simulate FSF Emacs implementation of this function: if point was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 in the region, place it at the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 if (old_pt >= begv && old_pt < zv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 BUF_SET_PT (buf, begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 return make_int (cc_decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 Base64-decode STRING and return the result.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 Characters out of the base64 alphabet are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 (string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3751 Intbyte *decoded;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3752 Bytebpos decoded_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 Charcount length, cc_decoded_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 Lisp_Object input, result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 int speccount = specpdl_depth();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 CHECK_STRING (string);
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 length = XSTRING_CHAR_LENGTH (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 /* 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
3761 XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Intbyte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 input = make_lisp_string_input_stream (string, 0, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 decoded_length = base64_decode_1 (XLSTREAM (input), decoded,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 &cc_decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 if (decoded_length > length * MAX_EMCHAR_LEN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 Lstream_delete (XLSTREAM (input));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 result = make_string (decoded, decoded_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 Lisp_Object Qyes_or_no_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 syms_of_fns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3780 INIT_LRECORD_IMPLEMENTATION (bit_vector);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3781
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3782 DEFSYMBOL (Qstring_lessp);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3783 DEFSYMBOL (Qidentity);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3784 DEFSYMBOL (Qyes_or_no_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3785
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 456
diff changeset
3786 DEFERROR_STANDARD (Qbase64_conversion_error, Qconversion_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 DEFSUBR (Fidentity);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 DEFSUBR (Frandom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 DEFSUBR (Flength);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 DEFSUBR (Fsafe_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 DEFSUBR (Fstring_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 DEFSUBR (Fstring_lessp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 DEFSUBR (Fstring_modified_tick);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 DEFSUBR (Fappend);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 DEFSUBR (Fconcat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 DEFSUBR (Fvconcat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 DEFSUBR (Fbvconcat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 DEFSUBR (Fcopy_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 DEFSUBR (Fcopy_sequence);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 DEFSUBR (Fcopy_alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 DEFSUBR (Fcopy_tree);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 DEFSUBR (Fsubstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 DEFSUBR (Fsubseq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 DEFSUBR (Fnthcdr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 DEFSUBR (Fnth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 DEFSUBR (Felt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 DEFSUBR (Flast);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 DEFSUBR (Fbutlast);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 DEFSUBR (Fnbutlast);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 DEFSUBR (Fmember);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 DEFSUBR (Fold_member);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 DEFSUBR (Fmemq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 DEFSUBR (Fold_memq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 DEFSUBR (Fassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 DEFSUBR (Fold_assoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 DEFSUBR (Fassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 DEFSUBR (Fold_assq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 DEFSUBR (Frassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 DEFSUBR (Fold_rassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 DEFSUBR (Frassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 DEFSUBR (Fold_rassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 DEFSUBR (Fdelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 DEFSUBR (Fold_delete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 DEFSUBR (Fdelq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 DEFSUBR (Fold_delq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 DEFSUBR (Fremassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 DEFSUBR (Fremassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 DEFSUBR (Fremrassoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 DEFSUBR (Fremrassq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 DEFSUBR (Fnreverse);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 DEFSUBR (Freverse);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 DEFSUBR (Fsort);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 DEFSUBR (Fplists_eq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 DEFSUBR (Fplists_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 DEFSUBR (Flax_plists_eq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 DEFSUBR (Flax_plists_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 DEFSUBR (Fplist_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 DEFSUBR (Fplist_put);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 DEFSUBR (Fplist_remprop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 DEFSUBR (Fplist_member);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 DEFSUBR (Fcheck_valid_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 DEFSUBR (Fvalid_plist_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 DEFSUBR (Fcanonicalize_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845 DEFSUBR (Flax_plist_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 DEFSUBR (Flax_plist_put);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 DEFSUBR (Flax_plist_remprop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 DEFSUBR (Flax_plist_member);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 DEFSUBR (Fcanonicalize_lax_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 DEFSUBR (Fdestructive_alist_to_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 DEFSUBR (Fget);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 DEFSUBR (Fput);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 DEFSUBR (Fremprop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 DEFSUBR (Fobject_plist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 DEFSUBR (Fequal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 DEFSUBR (Fold_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 DEFSUBR (Ffillarray);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 DEFSUBR (Fnconc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 DEFSUBR (Fmapcar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 DEFSUBR (Fmapvector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 DEFSUBR (Fmapc_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 DEFSUBR (Fmapconcat);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3863 DEFSUBR (Freplace_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 DEFSUBR (Fload_average);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 DEFSUBR (Ffeaturep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 DEFSUBR (Frequire);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 DEFSUBR (Fprovide);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 DEFSUBR (Fbase64_encode_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 DEFSUBR (Fbase64_encode_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 DEFSUBR (Fbase64_decode_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 DEFSUBR (Fbase64_decode_string);
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 init_provide_once (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 DEFVAR_LISP ("features", &Vfeatures /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 A list of symbols which are the features of the executing emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 Used by `featurep' and `require', and altered by `provide'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 Vfeatures = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883 Fprovide (intern ("base64"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884 }