annotate src/lread.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 6e99cc8c6ca5
children 943eaba38521
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 /* Lisp parsing and input streams.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Tinker Systems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1996 Ben Wing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 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
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 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
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "lisp.h"
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 "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "file-coding.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "sysfile.h"
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 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #define THIS_FILENAME lread
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "sysfloat.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Lisp_Object Qread_char, Qstandard_input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Lisp_Object Qvariable_documentation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #define LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 Nonzero means inside a new-style backquote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 with no surrounding parentheses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 Fread initializes this to zero, so we need not specbind it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 or worry about what happens to it when there is an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 XEmacs:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Nested backquotes are perfectly legal and fail utterly with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 this silliness. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 static int new_backquote_flag, old_backquote_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Qvariable_domain; /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 Lisp_Object Qcurrent_load_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 Lisp_Object Qload, Qload_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 Lisp_Object Qfset;
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 /* Hash-table that maps directory names to hashes of their contents. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 static Lisp_Object Vlocate_file_hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 /* See read_escape() for an explanation of this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 int fail_on_bucky_bit_character_escapes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 /* This symbol is also used in fns.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 #define FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Lisp_Object Qfeaturep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 /* non-zero if inside `load' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 int load_in_progress;
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 /* Whether Fload_internal() should check whether the .el is newer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 when loading .elc */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 int load_warn_when_source_newer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 /* Whether Fload_internal() should check whether the .elc doesn't exist */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 int load_warn_when_source_only;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 int load_ignore_elc_files;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 /* Search path for files to be loaded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 Lisp_Object Vload_path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 /* Search path for files when dumping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 /* Lisp_Object Vdump_load_path; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 /* This is the user-visible association list that maps features to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 lists of defs in their load files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Lisp_Object Vload_history;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 /* This is used to build the load history. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 Lisp_Object Vcurrent_load_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 /* Name of file actually being read by `load'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Lisp_Object Vload_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 our #$ checks are reliable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Lisp_Object Vload_file_name_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 Lisp_Object Vload_file_name_internal_the_purecopy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 /* Function to use for reading, in `load' and friends. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Lisp_Object Vload_read_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 /* The association list of objects read with the #n=object form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Each member of the list has the form (n . object), and is used to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 look up the object for the corresponding #n# construct.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 It must be set to nil before all top-level calls to read0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Lisp_Object Vread_objects;
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 /* Nonzero means load should forcibly load all dynamic doc strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 /* Note that this always happens (with some special behavior) when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 purify_flag is set. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 static int load_force_doc_strings;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 /* List of descriptors now open for Fload_internal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 static Lisp_Object Vload_descriptor_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 /* In order to implement "load_force_doc_strings", we keep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 a list of all the compiled-function objects and such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 that we have created in the process of loading this file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 See the rant below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 We specbind this just like Vload_file_name, so there's no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 problems with recursive loading. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 static Lisp_Object Vload_force_doc_string_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 /* A resizing-buffer stream used to temporarily hold data while reading */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 static Lisp_Object Vread_buffer_stream;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Lisp_Object Vcurrent_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 static int load_byte_code_version;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 /* An array describing all known built-in structure types */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 static structure_type_dynarr *the_structure_type_dynarr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 #if 0 /* FSF defun hack */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* When nonzero, read conses in pure space */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 static int read_pure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 #endif
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 #if 0 /* FSF stuff */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 /* For use within read-from-string (this reader is non-reentrant!!) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 static int read_from_string_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 static int read_from_string_limit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 #if 0 /* More FSF implementation kludges. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 /* In order to implement load-force-doc-string, FSF saves the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 #@-quoted string when it's seen, and goes back and retrieves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 it later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 This approach is not only kludgy, but it in general won't work
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 correctly because there's no stack of remembered #@-quoted-strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 and those strings don't generally appear in the file in the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 order as their #$ references. (Yes, that is amazingly stupid too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 It would be trivially easy to always encode the #@ string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 [which is a comment, anyway] in the middle of the (#$ . INT) cons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 reference. That way, it would be really easy to implement
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 load-force-doc-string in a non-kludgy way by just retrieving the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 string immediately, because it's delivered on a silver platter.)
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 And finally, this stupid approach doesn't work under Mule, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 under MS-DOS or Windows NT, or under VMS, or any other place
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 where you either can't do an ftell() or don't get back a byte
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 count.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Oh, and one more lossage in this approach: If you attempt to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 dump any ELC files that were compiled with `byte-compile-dynamic'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (as opposed to just `byte-compile-dynamic-docstring'), you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 get hosed. FMH! (as the illustrious JWZ was prone to utter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 The approach we use is clean, solves all of these problems, and is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 probably easier to implement anyway. We just save a list of all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 the containing objects that have (#$ . INT) conses in them (this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 will only be compiled-function objects and lists), and when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 file is finished loading, we go through and fill in all the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 doc strings at once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 /* This contains the last string skipped with #@. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 static char *saved_doc_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 /* Length of buffer allocated in saved_doc_string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 static int saved_doc_string_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 /* Length of actual data in saved_doc_string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 static int saved_doc_string_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 /* This is the file position that string came from. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 static int saved_doc_string_position;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 EXFUN (Fread_from_string, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 /* When errors are signaled, the actual readcharfun should not be used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 as an argument if it is an lstream, so that lstreams don't escape
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 to the Lisp level. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 ? (build_string ("internal input stream")) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 : (x))
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 static DOESNT_RETURN
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
221 read_syntax_error (const char *string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
223 signal_error (Qinvalid_read_syntax, string, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
227 continuable_read_syntax_error (const char *string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
229 return signal_continuable_error (Qinvalid_read_syntax, string, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 /* Handle unreading and rereading of characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 static Emchar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 readchar (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 Emchar c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 struct buffer *b = XBUFFER (readcharfun);
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 if (!BUFFER_LIVE_P (b))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
245 invalid_operation ("Reading from killed buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 if (BUF_PT (b) >= BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 c = BUF_FETCH_CHAR (b, BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 BUF_SET_PT (b, BUF_PT (b) + 1);
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 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 else if (LSTREAMP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 #ifdef DEBUG_XEMACS /* testing Mule */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 static int testing_mule = 0; /* Change via debugger */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
259 if (testing_mule)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
260 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
261 if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
262 else if (c == '\n') stderr_out ("\\n\n");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
263 else stderr_out ("\\%o ", c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
264 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
265 #endif /* testing Mule */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 return c;
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 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 Emchar c;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
271 Charbpos mpos = marker_position (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 if (mpos >= BUF_ZV (inbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 c = BUF_FETCH_CHAR (inbuffer, mpos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 set_marker_position (readcharfun, mpos + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 Lisp_Object tem = call0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 if (!CHAR_OR_CHAR_INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 return XCHAR_OR_CHAR_INT (tem);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 /* Unread the character C in the way appropriate for the stream READCHARFUN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 If the stream is a user function, call it with the char as argument. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 unreadchar (Lisp_Object readcharfun, Emchar c)
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 if (c == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 /* Don't back up the pointer if we're unreading the end-of-input mark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 since readchar didn't advance it when we read it. */
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 else if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 else if (LSTREAMP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 #ifdef DEBUG_XEMACS /* testing Mule */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 static int testing_mule = 0; /* Set this using debugger */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 if (testing_mule)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 fprintf (stderr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 call1 (readcharfun, make_char (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 static Lisp_Object read0 (Lisp_Object readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 static Lisp_Object read1 (Lisp_Object readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 /* allow_dotted_lists means that something like (foo bar . baz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 is acceptable. If -1, means check for starting with defun
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 and make structure pure. (not implemented, probably for very
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 good reasons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 If check_for_doc_references, look for (#$ . INT) doc references
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 in the list and record if load_force_doc_strings is non-zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (Such doc references will be destroyed during the loadup phase
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 by replacing with Qzero, because Snarf-documentation will fill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 them in again.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 WARNING: If you set this, you sure as hell better not call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 free_list() on the returned list here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 static Lisp_Object read_list (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 Emchar terminator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 int allow_dotted_lists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 int check_for_doc_references);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 static void readevalloop (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 Lisp_Object sourcefile,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 Lisp_Object (*evalfun) (Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 int printflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
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 Lstream_close (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 if (--load_in_progress < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 load_in_progress = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 load_descriptor_unwind (Lisp_Object oldlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 Vload_descriptor_list = oldlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 load_file_name_internal_unwind (Lisp_Object oldval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 Vload_file_name_internal = oldval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 Vload_file_name_internal_the_purecopy = oldval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 load_byte_code_version_unwind (Lisp_Object oldval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 load_byte_code_version = XINT (oldval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 /* The plague is coming.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 Ring around the rosy, pocket full of posy,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 Ashes ashes, they all fall down.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 ebolify_bytecode_constants (Lisp_Object vector)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 int len = XVECTOR_LENGTH (vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 for (i = 0; i < len; i++)
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 Lisp_Object el = XVECTOR_DATA (vector)[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 /* We don't check for `eq', `equal', and the others that have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 bytecode opcodes. This might lose if someone passes #'eq or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 something to `funcall', but who would really do that? As
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 they say in law, we've made a "good-faith effort" to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 unfuckify ourselves. And doing it this way avoids screwing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 up args to `make-hash-table' and such. As it is, we have to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 add an extra Ebola check in decode_weak_list_type(). --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 if (EQ (el, Qassoc)) el = Qold_assoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 else if (EQ (el, Qdelq)) el = Qold_delq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 /* I think this is a bad idea because it will probably mess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 with keymap code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 else if (EQ (el, Qdelete)) el = Qold_delete;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 else if (EQ (el, Qrassq)) el = Qold_rassq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 XVECTOR_DATA (vector)[i] = el;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 static Lisp_Object
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
422 pas_de_holgazan_ici (int fd, Lisp_Object victim)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 EMACS_INT pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 if (!INTP (XCDR (victim)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
428 invalid_byte_code ("Bogus doc string reference", victim);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 pos = XINT (XCDR (victim));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 if (pos < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 pos = -pos; /* kludge to mark a user variable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 if (!STRINGP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
434 signal_error_1 (Qinvalid_byte_code, tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 load_force_doc_string_unwind (Lisp_Object oldlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 Lisp_Object list = Vload_force_doc_string_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 int fd = XINT (XCAR (Vload_descriptor_list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 GCPRO1 (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 /* restore the old value first just in case an error occurs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 Vload_force_doc_string_list = oldlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 LIST_LOOP (tail, list)
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 john = Fcar (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 if (CONSP (john))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 assert (CONSP (XCAR (john)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 assert (!purify_flag); /* should have been handled in read_list() */
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
457 XCAR (john) = pas_de_holgazan_ici (fd, XCAR (john));
428
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 Lisp_Object doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 assert (COMPILED_FUNCTIONP (john));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 struct gcpro ngcpro1;
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
467 Lisp_Object juan = (pas_de_holgazan_ici
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (fd, XCOMPILED_FUNCTION (john)->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 Lisp_Object ivan;
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 NGCPRO1 (juan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 ivan = Fread (juan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 if (!CONSP (ivan))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
474 invalid_byte_code ("invalid lazy-loaded byte code", ivan);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 if (XCOMPILED_FUNCTION (john)->flags.ebolified
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 && VECTORP (XCDR (ivan)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 ebolify_bytecode_constants (XCDR (ivan));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 if (CONSP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 assert (!purify_flag); /* should have been handled in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 read_compiled_function() */
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
488 doc = pas_de_holgazan_ici (fd, doc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 }
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 if (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 free_list (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 /* Close all descriptors in use for Fload_internal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 This is used when starting a subprocess. */
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 close_load_descs (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 LIST_LOOP (tail, Vload_descriptor_list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 close (XINT (XCAR (tail)));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 Lisp_Object Vfile_domain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 restore_file_domain (Lisp_Object val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 Vfile_domain = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 return Qnil;
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 #endif /* I18N3 */
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 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 Execute a file of Lisp code named FILE; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 This function is identical to `load' except for the handling of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 support is not present, both functions are identical and ignore the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 CODESYS and USED-CODESYS arguments.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 If support for Mule exists in this Emacs, the file is decoded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 according to CODESYS; if omitted, no conversion happens. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 system that was used for the decoding is stored into it. It will in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 general be different from CODESYS if CODESYS specifies automatic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 encoding detection or end-of-line detection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
538 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 int fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 int source_only = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 Lisp_Object newer = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 Lisp_Object handler = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 Lisp_Object found = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 int reading_elc = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 int message_p = NILP (nomessage);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 /*#ifdef DEBUG_XEMACS*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 static Lisp_Object last_file_loaded;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 /*#endif*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 struct stat s1, s2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 GCPRO3 (file, newer, found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 CHECK_STRING (file);
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 /*#ifdef DEBUG_XEMACS*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 if (purify_flag && noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 message_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 last_file_loaded = file;
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 /*#endif / * DEBUG_XEMACS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 /* If file name is magic, call the handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 handler = Ffind_file_name_handler (file, Qload);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 if (!NILP (handler))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
569 RETURN_UNGCPRO (call5 (handler, Qload, file, noerror,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 nomessage, nosuffix));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 /* Do this after the handler to avoid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 the need to gcpro noerror, nomessage and nosuffix.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (Below here, we care only whether they are nil or not.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 file = Fsubstitute_in_file_name (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 CHECK_SYMBOL (used_codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 /* Avoid weird lossage with null string as arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 since it would try to load a directory as a Lisp file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 Unix truly sucks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 if (XSTRING_LENGTH (file) > 0)
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 char *foundstr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 int foundlen;
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 fd = locate_file (Vload_path, file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 ((!NILP (nosuffix)) ? Qnil :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 build_string (load_ignore_elc_files ? ".el:" :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 ".elc:.el:")),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 &found,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
598 if (NILP (noerror))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
599 signal_error (Qfile_error, "Cannot open load file", file);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 strcpy (foundstr, (char *) XSTRING_DATA (found));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 foundlen = strlen (foundstr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 /* The omniscient JWZ thinks this is worthless, but I beg to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 differ. --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 if (load_ignore_elc_files)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 newer = Ffile_name_nondirectory (found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 else if (load_warn_when_source_newer &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 !memcmp (".elc", foundstr + foundlen - 4, 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 if (! fstat (fd, &s1)) /* can't fail, right? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 int result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 /* temporarily hack the 'c' off the end of the filename */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 foundstr[foundlen - 1] = '\0';
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
625 result = xemacs_stat (foundstr, &s2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 if (result >= 0 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
629 Lisp_Object newer_name = make_string ((Intbyte *) foundstr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 foundlen - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 struct gcpro nngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 NNGCPRO1 (newer_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 newer = Ffile_name_nondirectory (newer_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 NNUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 /* put the 'c' back on (kludge-o-rama) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 foundstr[foundlen - 1] = 'c';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 else if (load_warn_when_source_only &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 /* `found' ends in ".el" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 !memcmp (".el", foundstr + foundlen - 3, 3) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 /* `file' does not end in ".el" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 memcmp (".el",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 source_only = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 reading_elc = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 #define PRINT_LOADING_MESSAGE(done) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 if (load_ignore_elc_files) \
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 if (message_p) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 message ("Loading %s..." done, XSTRING_DATA (newer)); \
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 else if (!NILP (newer)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 message ("Loading %s..." done " (file %s is newer)", \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 XSTRING_DATA (file), \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 XSTRING_DATA (newer)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 else if (source_only) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 message ("Loading %s..." done " (file %s.elc does not exist)", \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 XSTRING_DATA (file), \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 XSTRING_DATA (Ffile_name_nondirectory (file))); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 else if (message_p) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 message ("Loading %s..." done, XSTRING_DATA (file)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 PRINT_LOADING_MESSAGE ("");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 /* Lisp_Object's must be malloc'ed, not stack-allocated */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 Lisp_Object lispstream = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
678 const int block_size = 8192;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 NGCPRO1 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 /* 64K is used for normal files; 8K should be OK here because Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 files aren't really all that big. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 block_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 lispstream = make_decoding_input_stream
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (XLSTREAM (lispstream), Fget_coding_system (codesys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 block_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 /* NOTE: Order of these is very important. Don't rearrange them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 record_unwind_protect (load_unwind, lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 record_unwind_protect (load_file_name_internal_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 Vload_file_name_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 Vload_file_name_internal_the_purecopy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 record_unwind_protect (load_force_doc_string_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 Vload_file_name_internal = found;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 Vload_file_name_internal_the_purecopy = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 specbind (Qload_file_name, found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 Vload_force_doc_string_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 record_unwind_protect (restore_file_domain, Vfile_domain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 load_in_progress++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 /* Now determine what sort of ELC file we're reading in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 record_unwind_protect (load_byte_code_version_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 make_int (load_byte_code_version));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 if (reading_elc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 char elc_header[8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 int num_read;
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 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 if (num_read < 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 || strncmp (elc_header, ";ELC", 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 /* Huh? Probably not a valid ELC file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 load_byte_code_version = 100; /* no Ebolification needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 load_byte_code_version = elc_header[4];
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 load_byte_code_version = 100; /* no Ebolification needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 readevalloop (lispstream, file, Feval, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 #ifdef FILE_CODING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 Fset (used_codesys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 XCODING_SYSTEM_NAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (decoding_stream_coding_system (XLSTREAM (lispstream))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 NUNGCPRO;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 /* #### Disgusting kludge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 /* Run any load-hooks for this file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 /* #### An even more disgusting kludge. There is horrible code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 /* that is relying on the fact that dumped lisp files are found */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 /* via `load-path' search. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 Lisp_Object name = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 if (!NILP(Ffile_name_absolute_p(file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 name = Ffile_name_nondirectory(file);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 NGCPRO1 (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 tem = Fassoc (name, Vafter_load_alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 NUNGCPRO;
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 (!NILP (tem))
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 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 NGCPRO1 (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 tem = Fcons (Qprogn, Fcdr (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 Feval (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 /*#ifdef DEBUG_XEMACS*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 if (purify_flag && noninteractive)
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 if (!EQ (last_file_loaded, file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 message ("Loading %s ...done", XSTRING_DATA (file));
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 /*#endif / * DEBUG_XEMACS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 if (!noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 PRINT_LOADING_MESSAGE ("done");
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 /* ------------------------------- */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 /* locate_file */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 /* ------------------------------- */
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 decode_mode_1 (Lisp_Object mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 if (EQ (mode, Qexists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 return F_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 else if (EQ (mode, Qexecutable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 return X_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 else if (EQ (mode, Qwritable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 return W_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 else if (EQ (mode, Qreadable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 return R_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 else if (INTP (mode))
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 check_int_range (XINT (mode), 0, 7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 return XINT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
817 invalid_argument ("Invalid value", mode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 return 0; /* unreached */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 decode_mode (Lisp_Object mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 return R_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 else if (CONSP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 int mask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 EXTERNAL_LIST_LOOP (tail, mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 mask |= decode_mode_1 (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 return mask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 return decode_mode_1 (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 Search for FILENAME through PATH-LIST.
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 If SUFFIXES is non-nil, it should be a list of suffixes to append to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 file name when searching.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 If MODE is non-nil, it should be a symbol or a list of symbol representing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 requirements. Allowed symbols are `exists', `executable', `writable', and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 `readable'. If MODE is nil, it defaults to `readable'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 `locate-file' keeps hash tables of the directories it searches through,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 in order to speed things up. It tries valiantly to not get confused in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 the face of a changing and unpredictable environment, but can occasionally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 get tripped up. In this case, you will have to call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 `locate-file-clear-hashing' to get it back on track. See that function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 for details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (filename, path_list, suffixes, mode))
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 Lisp_Object tp;
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 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 if (LISTP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 EXTERNAL_LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 CHECK_STRING (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 CHECK_STRING (suffixes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 return tp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 /* Recalculate the hash table for the given string. DIRECTORY should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 better have been through Fexpand_file_name() by now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 locate_file_refresh_hashing (Lisp_Object directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 Lisp_Object hash =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 make_directory_hash_table ((char *) XSTRING_DATA (directory));
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 if (!NILP (hash))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 Fputhash (directory, hash, Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 /* find the hash table for the given directory, recalculating if necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 locate_file_find_directory_hash_table (Lisp_Object directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 if (NILP (hash))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 return locate_file_refresh_hashing (directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 return hash;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 /* The SUFFIXES argument in any of the locate_file* functions can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 nil, a list, or a string (for backward compatibility), with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 following semantics:
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 a) nil - no suffix, just search for file name intact
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 (semantically different from "empty suffix list", which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 would be meaningless.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 b) list - list of suffixes to append to file name. Each of these
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 must be a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 c) string - colon-separated suffixes to append to file name (backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 compatibility).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 All of this got hairy, so I decided to use a mapper. Calling a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 function for each suffix shouldn't slow things down, since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 locate_file is rarely called with enough suffixes for funcalls to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 make any difference. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 char * containing the current file name, and ARG. Mapping stops when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 FUN returns non-zero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 int (*fun) (char *, void *),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 char *fn;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 int fn_len, max;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 /* Calculate maximum size of any filename made from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 this path element/specified file name and any possible suffix. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 if (CONSP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 /* We must traverse the list, so why not do it right. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 max = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 if (XSTRING_LENGTH (XCAR (tail)) > max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 max = XSTRING_LENGTH (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 else if (NILP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 max = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 /* Just take the easy way out */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 max = XSTRING_LENGTH (suffixes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 fn_len = XSTRING_LENGTH (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 fn = (char *) alloca (max + fn_len + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 /* Loop over suffixes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 if (!STRINGP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 if (NILP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 /* Case a) discussed in the comment above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 fn[fn_len] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 /* Case b) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 XSTRING_LENGTH (XCAR (tail)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 /* Case c) */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
980 const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 char *esuffix = (char *) strchr (nsuffix, ':');
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 578
diff changeset
985 int lsuffix = esuffix ? esuffix - nsuffix : (int) strlen (nsuffix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 /* Concatenate path element/specified name with the suffix. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 strncpy (fn + fn_len, nsuffix, lsuffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 fn[fn_len + lsuffix] = 0;
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 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 /* Advance to next suffix. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 if (esuffix == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 nsuffix += lsuffix + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 struct locate_file_in_directory_mapper_closure {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 Lisp_Object *storeptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 locate_file_in_directory_mapper (char *fn, void *arg)
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 struct locate_file_in_directory_mapper_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 (struct locate_file_in_directory_mapper_closure *)arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 /* Ignore file if it's a directory. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1016 if (xemacs_stat (fn, &st) >= 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 && (st.st_mode & S_IFMT) != S_IFDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 /* Check that we can access or open it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 if (closure->mode >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 closure->fd = access (fn, closure->mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 if (closure->fd >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 /* We succeeded; return this descriptor and filename. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 if (closure->storeptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 *closure->storeptr = build_string (fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1031 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 /* If we actually opened the file, set close-on-exec flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 on the new descriptor so that subprocesses can't whack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 at it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 if (closure->mode < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 }
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 /* Keep mapping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 return 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 not have been expanded. */
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 Lisp_Object suffixes, Lisp_Object *storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 int mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 struct locate_file_in_directory_mapper_closure closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 Lisp_Object filename = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 GCPRO3 (directory, str, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 filename = Fexpand_file_name (str, directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 /* If there are non-absolute elts in PATH (eg ".") */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 /* Of course, this could conceivably lose if luser sets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 default-directory to be something non-absolute ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 if (NILP (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 /* NIL means current directory */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 filename = current_buffer->directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 filename = Fexpand_file_name (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 if (NILP (Ffile_name_absolute_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 /* Give up on this directory! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 return -1;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 closure.fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 closure.storeptr = storeptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 closure.mode = mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 return closure.fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 /* do the same as locate_file() but don't use any hash tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 Lisp_Object suffixes, Lisp_Object *storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 int mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 int absolute = !NILP (Ffile_name_absolute_p (str));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 EXTERNAL_LIST_LOOP (path, path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 if (absolute)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 return -1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
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 Lisp_Object *tail = (Lisp_Object *)arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 *tail = Fcons (build_string (fn), *tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 /* Construct a list of all files to search for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 It makes sense to have this despite locate_file_map_suffixes()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 because we need Lisp strings to access the hash-table, and it would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 be inefficient to create them on the fly, again and again for each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 path component. See locate_file(). */
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 locate_file_construct_suffixed_files (Lisp_Object filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 Lisp_Object suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 Lisp_Object tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 GCPRO1 (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 locate_file_map_suffixes (filename, suffixes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 locate_file_construct_suffixed_files_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 &tail);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 return Fnreverse (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 Clear the hash records for the specified list of directories.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 `locate-file' uses a hashing scheme to speed lookup, and will correctly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 track the following environmental changes:
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 -- changes of any sort to the list of directories to be searched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 -- addition and deletion of non-shadowing files (see below) from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 directories in the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 -- byte-compilation of a .el file into a .elc file.
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 `locate-file' will primarily get confused if you add a file that shadows
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 \(i.e. has the same name as) another file further down in the directory list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 In this case, you must call `locate-file-clear-hashing'.
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 If PATH is t, it means to fully clear all the accumulated hashes. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 can be used if the internal tables grow too large, or when dumping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 (path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 if (EQ (path, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 Fclrhash (Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 Lisp_Object pathtail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 EXTERNAL_LIST_LOOP (pathtail, path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 Fremhash (pathel, Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 return Qnil;
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 /* Search for a file whose name is STR, looking in directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 in the Lisp list PATH, and trying suffixes from SUFFIXES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 SUFFIXES is a list of possible suffixes, or (for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 compatibility) a string containing possible suffixes separated by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 colons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 On success, returns a file descriptor. On failure, returns -1.
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 MODE nonnegative means don't open the files,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 just look for one for which access(file,MODE) succeeds. In this case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 returns 1 on success.
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 If STOREPTR is nonzero, it points to a slot where the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 the file actually found should be stored as a Lisp string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 Nil is stored there on failure.
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 Called openp() in FSFmacs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 Lisp_Object *storeptr, int mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 Lisp_Object suffixtab = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 Lisp_Object pathtail, pathel_expanded;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 int val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 if (storeptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 *storeptr = Qnil;
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 /* Is it really necessary to gcpro path and str? It shouldn't be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 unless some caller has fucked up. There are known instances that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 call us with build_string("foo:bar") as SUFFIXES, though. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 GCPRO4 (path, str, suffixes, suffixtab);
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 /* if this filename has directory components, it's too complicated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 to try and use the hash tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 if (!NILP (Ffile_name_directory (str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
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 EXTERNAL_LIST_LOOP (pathtail, path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 Lisp_Object pathel = XCAR (pathtail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 int found = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 /* If this path element is relative, we have to look by hand. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1232 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 continue;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 pathel_expanded = Fexpand_file_name (pathel, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 if (!NILP (hash_table))
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 /* Loop over suffixes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 LIST_LOOP (tail, suffixtab)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
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 found = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 break;
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 }
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 if (found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 /* This is a likely candidate. Look by hand in this directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 so we don't get thrown off if someone byte-compiles a file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 }
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 /* Hmm ... the file isn't actually there. (Or possibly it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 a directory ...) So refresh our hashing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 locate_file_refresh_hashing (pathel_expanded);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 /* File is probably not there, but check the hard way just in case. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 /* Sneaky user added a file without telling us. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 Flocate_file_clear_hashing (path);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 }
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 #ifdef LOADHIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 /* Merge the list we've accumulated of globals from the current input source
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 into the load_history variable. The details depend on whether
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 the source has an associated file name or not. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 build_load_history (int loading, Lisp_Object source)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 REGISTER Lisp_Object tail, prev, newelt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 REGISTER Lisp_Object tem, tem2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 int foundit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 #if !defined(LOADHIST_DUMPED)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 /* Don't bother recording anything for preloaded files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 if (purify_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 tail = Vload_history;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 foundit = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 tem = Fcar (tail);
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 /* Find the feature's previous assoc list... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 if (internal_equal (source, Fcar (tem), 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 foundit = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 /* If we're loading, remove it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 if (loading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 Vload_history = Fcdr (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 Fsetcdr (prev, Fcdr (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 /* Otherwise, cons on new symbols that are not already members. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 tem2 = Vcurrent_load_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 while (CONSP (tem2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 newelt = XCAR (tem2);
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 if (NILP (Fmemq (newelt, tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 Fsetcar (tail, Fcons (Fcar (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 Fcons (newelt, Fcdr (tem))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 tem2 = XCDR (tem2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 }
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 tail = Fcdr (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 QUIT;
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 /* If we're loading, cons the new assoc onto the front of load-history,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 the most-recently-loaded position. Also do this if we didn't find
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 an existing member for the current source. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 if (loading || !foundit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 Vload_history);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 #else /* !LOADHIST */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 #define build_load_history(x,y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 #endif /* !LOADHIST */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 #if 0 /* FSFmacs defun hack */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 unreadpure (void) /* Used as unwind-protect function in readevalloop */
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 read_pure = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 return Qnil;
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 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 readevalloop (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 Lisp_Object sourcename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 Lisp_Object (*evalfun) (Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 int printflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 REGISTER Emchar c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 REGISTER Lisp_Object val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 struct buffer *b = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 b = XBUFFER (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 b = XMARKER (readcharfun)->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 /* Don't do this. It is not necessary, and it needlessly exposes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 READCHARFUN (which can be a stream) to Lisp. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 /*specbind (Qstandard_input, readcharfun);*/
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 specbind (Qcurrent_load_list, 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 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 GCPRO2 (val, sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 LOADHIST_ATTACH (sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 if (b != 0 && !BUFFER_LIVE_P (b))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1411 invalid_operation ("Reading from killed buffer", Qunbound);
428
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 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 if (c == ';')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 /* Skip comment */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 while ((c = readchar (readcharfun)) != '\n' && c != -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 /* Ignore whitespace here, so we can detect eof. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 continue;
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 #if 0 /* FSFmacs defun hack */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 if (purify_flag && c == '(')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 int count1 = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 record_unwind_protect (unreadpure, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 val = read_list (readcharfun, ')', -1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 unbind_to (count1, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
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 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 if (NILP (Vload_read_function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 val = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 val = call1 (Vload_read_function, readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 val = (*evalfun) (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 if (printflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 Vvalues = Fcons (val, Vvalues);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 if (EQ (Vstandard_output, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 Fprin1 (val, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 Fprint (val, Qnil);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 build_load_history (LSTREAMP (readcharfun) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 /* This looks weird, but it's what's in FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 Execute BUFFER as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 Programs can pass two arguments, BUFFER and PRINTFLAG.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 BUFFER is the buffer to evaluate (nil means use current buffer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 PRINTFLAG controls printing of output:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1472 nil means discard it; anything else is a stream for printing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 If there is no error, point does not move. If there is an error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 point remains at the end of the last character read from the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1477 (buffer, printflag))
428
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 Lisp_Object tem, buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1483 if (NILP (buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 buf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1486 buf = Fget_buffer (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 if (NILP (buf))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1488 invalid_argument ("No such buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 if (NILP (printflag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 tem = printflag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 specbind (Qstandard_output, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 record_unwind_protect (save_excursion_restore, save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 readevalloop (buf, XBUFFER (buf)->filename, Feval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 !NILP (printflag));
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 return unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 Execute the current buffer as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 Programs can pass argument PRINTFLAG which controls printing of output:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 nil means discard it; anything else is stream for print.
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 If there is no error, point does not move. If there is an error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 point remains at the end of the last character read from the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 (printflag))
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 code omitted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 Execute the region as Lisp code.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1520 When called from programs, expects two arguments START and END
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 giving starting and ending indices in the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 of the text to be executed.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1523 Programs can pass third optional argument STREAM which controls output:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 nil means discard it; anything else is stream for printing it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 If there is no error, point does not move. If there is an error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 point remains at the end of the last character read from the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 Note: Before evaling the region, this function narrows the buffer to it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 If the code being eval'd should happen to trigger a redisplay you may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 see some text temporarily disappear because of this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1533 (start, end, stream))
428
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 Lisp_Object cbuf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1540 if (NILP (stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1543 tem = stream;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 specbind (Qstandard_output, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1546 if (NILP (stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 record_unwind_protect (save_excursion_restore, save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 record_unwind_protect (save_restriction_restore, save_restriction_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1550 /* This both uses start and checks its type. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1551 Fgoto_char (start, cbuf);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1552 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1554 !NILP (stream));
428
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 return unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 }
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 DEFUN ("read", Fread, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 Read one Lisp expression as text from STREAM, return as Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 If STREAM is nil, use the value of `standard-input' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 STREAM or the value of `standard-input' may be:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 a buffer (read from point and advance it)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 a marker (read from where it points and advance it)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 a function (call it with no arguments for each character,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 call it with a char as argument to push a char back)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 a string (takes text from string, starting at the beginning)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 t (read text line using minibuffer and use it).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 if (NILP (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 stream = Vstandard_input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 if (EQ (stream, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 stream = Qread_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 if (EQ (stream, Qread_char))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 Lisp_Object val = call1 (Qread_from_minibuffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 build_translated_string ("Lisp expression: "));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 return Fcar (Fread_from_string (val, Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 if (STRINGP (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 return Fcar (Fread_from_string (stream, Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 return read0 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 Read one Lisp expression which is represented as text by STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 START and END optionally delimit a substring of STRING from which to read;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 they default to 0 and (length STRING) respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 (string, start, end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 Bytecount startval, endval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 Lisp_Object lispstream = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 struct gcpro gcpro1;
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 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 GCPRO1 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 get_string_range_byte (string, start, end, &startval, &endval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 GB_HISTORICAL_STRING_BEHAVIOR);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 lispstream = make_lisp_string_input_stream (string, startval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 endval - startval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 tem = read0 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 /* Yeah, it's ugly. Gonna make something of it?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 At least our reader is reentrant ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 tem =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 (Fcons (tem, make_int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 (bytecount_to_charcount
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 (XSTRING_DATA (string),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 Lstream_delete (XLSTREAM (lispstream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 backquote_unwind (Lisp_Object ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 { /* used as unwind-protect function in read0() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 int *counter = (int *) get_opaque_ptr (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 if (--*counter < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 *counter = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 free_opaque_ptr (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 #endif
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 /* Use this for recursive reads, in contexts where internal tokens
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 are not allowed. See also read1(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 read0 (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 Lisp_Object val = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 if (CONSP (val) && UNBOUNDP (XCAR (val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 Emchar c = XCHAR (XCDR (val));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 free_cons (XCONS (val));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 list1 (Fchar_to_string (make_char (c))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 static Emchar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 read_escape (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 Emchar c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1673 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
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 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 case 'a': return '\007';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 case 'b': return '\b';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 case 'd': return 0177;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 case 'e': return 033;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 case 'f': return '\f';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 case 'n': return '\n';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 case 'r': return '\r';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 case 't': return '\t';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 case 'v': return '\v';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 case '\n': return -1;
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 case 'M':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1691 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 if (c != '-')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1693 syntax_error ("Invalid escape character syntax", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1696 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 return c | 0200;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 /* Originally, FSF_KEYS provided a degree of FSF Emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 compatibility by defining character "modifiers" alt, super,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 hyper and shift to infest the characters (i.e. integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 However, this doesn't cut it for XEmacs 20, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 distinguishes characters from integers. Without Mule, ?\H-a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 simply returns ?a because every character is clipped into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 produces an illegal character, and moves us to crash-land.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 For these reasons, FSF_KEYS hack is useless and without hope
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 of ever working under XEmacs 20. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 #undef FSF_KEYS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 #ifdef FSF_KEYS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 #define alt_modifier (0x040000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 #define super_modifier (0x080000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 #define hyper_modifier (0x100000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 #define shift_modifier (0x200000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 /* fsf uses a different modifiers for meta and control. Possibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 byte_compiled code will still work fsfmacs, though... --Stig
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 #define ctl_modifier (0x400000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 #define meta_modifier (0x800000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1726 #define FSF_LOSSAGE(mask) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1727 if (fail_on_bucky_bit_character_escapes || \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1728 ((c = readchar (readcharfun)) != '-')) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1729 syntax_error ("Invalid escape character syntax", Qunbound); \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1730 c = readchar (readcharfun); \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1731 if (c < 0) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1732 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun)); \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1733 if (c == '\\') \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1734 c = read_escape (readcharfun); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 return c | mask
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 case 'S': FSF_LOSSAGE (shift_modifier);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 case 'H': FSF_LOSSAGE (hyper_modifier);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 case 'A': FSF_LOSSAGE (alt_modifier);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 case 's': FSF_LOSSAGE (super_modifier);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 #undef alt_modifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 #undef super_modifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 #undef hyper_modifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 #undef shift_modifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 #undef FSF_LOSSAGE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 #endif /* FSF_KEYS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 case 'C':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1752 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 if (c != '-')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1754 syntax_error ("Invalid escape character syntax", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 case '^':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1758 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 /* FSFmacs junk for non-ASCII controls.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 Not used here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 if (c == '?')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 return 0177;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 return c & (0200 | 037);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 case '0':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 case '1':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 case '2':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 case '3':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 case '4':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 case '5':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 case '6':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 case '7':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 /* An octal escape, as in ANSI C. */
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 REGISTER Emchar i = c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 REGISTER int count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 while (++count < 3)
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 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 i = (i << 3) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 else
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 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 return i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 case 'x':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 /* A hex escape, as in ANSI C, except that we only allow latin-1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 characters to be read this way. What is "\x4e03" supposed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 mean, anyways, if the internal representation is hidden?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 This is also consistent with the treatment of octal escapes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 REGISTER Emchar i = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 REGISTER int count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 while (++count <= 2)
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 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 return i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 /* #### need some way of reading an extended character with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 an escape sequence. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 #endif
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 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 return c;
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 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 static Bytecount
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 *saw_a_backslash = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 while (c > 040 /* #### - comma should be here as should backquote */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 && !(c == '\"' || c == '\'' || c == ';'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 || c == '(' || c == ')'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 #ifndef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 /* If we have floating-point support, then we need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 to allow <digits><dot><digits>. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 || c =='.'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 #endif /* not LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 || c == '[' || c == ']' || c == '#'
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 if (c == '\\')
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 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1854 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 *saw_a_backslash = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 if (c >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 /* blasted terminating 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 Lstream_flush (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1871 static Lisp_Object parse_integer (const Intbyte *buf, Bytecount len, int base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 read_atom (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 Emchar firstchar,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 int uninterned_symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 int saw_a_backslash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 char *read_ptr = (char *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 /* Is it an integer? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 if (! (saw_a_backslash || uninterned_symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 /* If a token had any backslashes in it, it is disqualified from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 being an integer or a float. This means that 123\456 is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 symbol, as is \123 (which is the way (intern "123") prints).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 Also, if token was preceded by #:, it's always a symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 char *p = read_ptr + len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 char *p1 = read_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 if (*p1 == '+' || *p1 == '-') p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 if (p1 != p)
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 int c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 while (p1 != p && (c = *p1) >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 /* Integers can have trailing decimal points. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 if (p1 > read_ptr && p1 < p && *p1 == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 if (p1 == p)
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 /* It is an integer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 if (p1[-1] == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 p1[-1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 int number = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 if (sizeof (int) == sizeof (EMACS_INT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 number = atoi (read_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 else if (sizeof (long) == sizeof (EMACS_INT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 number = atol (read_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 return make_int (number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 #else
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1926 return parse_integer ((Intbyte *) read_ptr, len, 10);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 if (isfloat_string (read_ptr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 return make_float (atof (read_ptr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 Lisp_Object sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 if (uninterned_symbol)
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1939 sym = Fmake_symbol ( make_string ((Intbyte *) read_ptr, len));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1942 Lisp_Object name = make_string ((Intbyte *) read_ptr, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 sym = Fintern (name, Qnil);
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 return sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 static Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1951 parse_integer (const Intbyte *buf, Bytecount len, int base)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1953 const Intbyte *lim = buf + len;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1954 const Intbyte *p = buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 EMACS_UINT num = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 int negativland = 0;
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 if (*p == '-')
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 negativland = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 p++;
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 else if (*p == '+')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 if (p == lim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 goto loser;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 for (; (p < lim) && (*p != '\0'); p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 int c = *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 EMACS_UINT onum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 if (isdigit (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 c = c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 else if (isupper (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 c = c - 'A' + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 else if (islower (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 c = c - 'a' + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 goto loser;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 if (c < 0 || c >= base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 goto loser;
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 onum = num;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 num = num * base + c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 if (num < onum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 goto overflow;
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
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 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 Lisp_Object result = make_int (int_result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 if (num && ((XINT (result) < 0) != negativland))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 if (XINT (result) != int_result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 overflow:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 list3 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 ("Integer constant overflow in reader"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 make_string (buf, len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 make_int (base)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 loser:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 list3 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 ("Invalid integer constant in reader"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 make_string (buf, len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 make_int (base)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 read_integer (Lisp_Object readcharfun, int base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 int saw_a_backslash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 return (parse_integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 ((saw_a_backslash)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 ? 0 /* make parse_integer signal error */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 : len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 base));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 read_bit_vector (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2036 Lisp_Object val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2040 unsigned char bit;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2041 Emchar c = readchar (readcharfun);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2042 if (c == '0')
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2043 bit = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2044 else if (c == '1')
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2045 bit = 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2046 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2047 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2048 if (c >= 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2049 unreadchar (readcharfun, c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2050 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2051 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2052 Dynarr_add (dyn, bit);
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
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2055 val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2056 Dynarr_length (dyn));
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2057 Dynarr_free (dyn);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2058
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2059 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 /* structures */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 struct structure_type *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 define_structure_type (Lisp_Object type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 int (*validate) (Lisp_Object data,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
2069 Error_Behavior errb),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 Lisp_Object (*instantiate) (Lisp_Object data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 struct structure_type st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 st.type = type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 st.keywords = Dynarr_new (structure_keyword_entry);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 st.validate = validate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 st.instantiate = instantiate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 Dynarr_add (the_structure_type_dynarr, st);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 return Dynarr_atp (the_structure_type_dynarr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 Dynarr_length (the_structure_type_dynarr) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 int (*validate) (Lisp_Object keyword,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 Lisp_Object value,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
2088 Error_Behavior errb))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 struct structure_keyword_entry en;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 en.keyword = keyword;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 en.validate = validate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 Dynarr_add (st->keywords, en);
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 static struct structure_type *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 recognized_structure_type (Lisp_Object type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
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 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 if (EQ (st->type, type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 return st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 read_structure (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 Emchar c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 Lisp_Object orig_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 Lisp_Object already_seen = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 int keyword_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 struct structure_type *st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 struct gcpro gcpro1, gcpro2;
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 GCPRO2 (orig_list, already_seen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 if (c != '(')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2125 RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 list = read_list (readcharfun, ')', 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 orig_list = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 int len = XINT (Flength (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 if (len == 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2131 RETURN_UNGCPRO (continuable_read_syntax_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 ("structure type not specified"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 if (!(len & 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 RETURN_UNGCPRO
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2135 (continuable_read_syntax_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 ("structures must have alternating keyword/value pairs"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 st = recognized_structure_type (XCAR (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 if (!st)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 list2 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 ("unrecognized structure type"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 XCAR (list))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 keyword_count = Dynarr_length (st->keywords);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 while (!NILP (list))
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 Lisp_Object keyword, value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 struct structure_keyword_entry *en = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 keyword = Fcar (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 value = Fcar (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 if (!NILP (memq_no_quit (keyword, already_seen)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 list2 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 ("structure keyword already seen"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 keyword)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 for (i = 0; i < keyword_count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 en = Dynarr_atp (st->keywords, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 if (EQ (keyword, en->keyword))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 if (i == keyword_count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 list2 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 ("unrecognized structure keyword"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 keyword)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 RETURN_UNGCPRO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 list3 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 ("invalid value for structure keyword"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 keyword, value)));
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 already_seen = Fcons (keyword, already_seen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 list2 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 ("invalid structure initializer"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 orig_list)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 int terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 /* Get the next character; filter out whitespace and comments */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 static Emchar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 reader_nextchar (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 Emchar c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2214 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
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 switch (c)
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 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 /* Ignore whitespace and control characters */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 if (c <= 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 case ';':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 /* Comment */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 }
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 #endif
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 /* Read the next Lisp object from the stream READCHARFUN and return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 If the return value is a cons whose car is Qunbound, then read1()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 encountered a misplaced token (e.g. a right bracket, right paren,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 or dot followed by a non-number). To filter this stuff out,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 use read0(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 read1 (Lisp_Object readcharfun)
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 Emchar c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 c = reader_nextchar (readcharfun);
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 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 case '(':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 /* if this is disabled, then other code in eval.c must be enabled */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 Emchar ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 switch (ch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 case '`':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 ++old_backquote_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 record_unwind_protect (backquote_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 make_opaque_ptr (&old_backquote_flag));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 tem = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 if (ch != ')')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 list1 (build_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 ("Weird old-backquote syntax")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 return list2 (Qbacktick, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 case ',':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 if (old_backquote_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 Lisp_Object tem, comma_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 ch = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 if (ch == '@')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 comma_type = Qcomma_at;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 if (ch >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 comma_type = Qcomma;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 tem = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 if (ch != ')')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 list1 (build_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 ("Weird old-backquote syntax")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 return list2 (comma_type, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 list1 (build_string ("Comma outside of backquote")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 /* #### - yuck....but this is reverse compatible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 /* mostly this is required by edebug, which does its own
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 annotated reading. We need to have an annotated_read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 function that records (with markers) the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 positions of the elements that make up lists, then that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 can be used in edebug and bytecomp and the check above
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 can go back in. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 } /* switch(ch) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 #endif /* old backquote crap... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 return read_list (readcharfun, ')', 1, 1);
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 case '[':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 return read_vector (readcharfun, ']');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 case ')':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 case ']':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 /* #### - huh? these don't do what they seem... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 return noseeum_cons (Qunbound, make_char (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 case '.':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 /* If a period is followed by a number, then we should read it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 as a floating point number. Otherwise, it denotes a dotted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 pair.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 unreadchar (readcharfun, c);
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 /* Can't use isdigit on Emchars */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 if (c < '0' || c > '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 return noseeum_cons (Qunbound, make_char ('.'));
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 /* Note that read_atom will loop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 at least once, assuring that we will not try to UNREAD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 two characters in a row.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 (I think this doesn't matter anymore because there should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 be no more danger in unreading multiple characters) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 return read_atom (readcharfun, '.', 0);
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 #else /* ! LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 return noseeum_cons (Qunbound, make_char ('.'));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 #endif /* ! LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 case '#':
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 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 #if 0 /* FSFmacs silly char-table syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 case '^':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 #if 0 /* FSFmacs silly bool-vector syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 case '&':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 /* "#["-- byte-code constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 /* purecons #[...] syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 case '[': return read_compiled_function (readcharfun, ']'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 /*, purify_flag */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 /* "#:"-- gensym syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 case ':': return read_atom (readcharfun, -1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 /* #'x => (function x) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 case '\'': return list2 (Qfunction, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 /* RMS uses this syntax for fat-strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 If we use it for vectors, then obscure bugs happen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 /* "#(" -- Scheme/CL vector syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 case '(': return read_vector (readcharfun, ')');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 case '(':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 Lisp_Object tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 struct gcpro gcpro1;
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 /* Read the string itself. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 tmp = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 if (!STRINGP (tmp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 free_cons (XCONS (tmp));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 GCPRO1 (tmp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 /* Read the intervals and their properties. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 while (1)
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 Lisp_Object beg, end, plist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 Emchar ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 int invalid = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 beg = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
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 ch = XCHAR (XCDR (beg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 free_cons (XCONS (beg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 if (ch == ')')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 if (!invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 end = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 if (CONSP (end) && UNBOUNDP (XCAR (end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 free_cons (XCONS (end));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 if (!invalid)
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 plist = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 free_cons (XCONS (plist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 if (invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 RETURN_UNGCPRO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 list2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 (build_string ("invalid string property list"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 XCDR (plist))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 Fset_text_properties (beg, end, plist, tmp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 return tmp;
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 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 case '@':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 /* #@NUMBER is used to skip NUMBER following characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 That's used in .elc files to skip over doc strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 and function definitions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 int i, nskip = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 /* Read a decimal integer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 while ((c = readchar (readcharfun)) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 && c >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 nskip = (10 * nskip) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 if (c >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 unreadchar (readcharfun, c);
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 /* FSF has code here that maybe caches the skipped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 string. See above for why this is totally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 losing. We handle this differently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 /* Skip that many characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 for (i = 0; i < nskip && c >= 0; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 goto retry;
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 case '$': return Vload_file_name_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 /* bit vectors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 case '*': return read_bit_vector (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 /* #o10 => 8 -- octal constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 case 'o': return read_integer (readcharfun, 8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 /* #xdead => 57005 -- hex constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 case 'x': return read_integer (readcharfun, 16);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 /* #b010 => 2 -- binary constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 case 'b': return read_integer (readcharfun, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 case 's': return read_structure (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 case '<':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 list1 (build_string ("Cannot read unreadable object")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 case '+':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 case '-':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 {
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2502 Lisp_Object feature_exp, obj, tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2505 feature_exp = read0(readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 obj = read0(readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 /* the call to `featurep' may GC. */
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2509 GCPRO2 (feature_exp, obj);
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2510 tem = call1 (Qfeaturep, feature_exp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 if (c == '+' && NILP(tem)) goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 if (c == '-' && !NILP(tem)) goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 case '0': case '1': case '2': case '3': case '4':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 case '5': case '6': case '7': case '8': case '9':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 /* Reader forms that can reuse previously read objects. */
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 int n = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 Lisp_Object found;
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 /* Using read_integer() here is impossible, because it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 chokes on `='. Using parse_integer() is too hard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 So we simply read it in, and ignore overflows, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 is safe. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 while (c >= '0' && c <= '9')
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 n *= 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 n += c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 c = readchar (readcharfun);
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 found = assq_no_quit (make_int (n), Vread_objects);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 if (c == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 /* #n=object returns object, but associates it with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 n for #n#. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 Lisp_Object obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 if (CONSP (found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 list2 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 ("Multiply defined symbol label"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 make_int (n)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 obj = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 Vread_objects = Fcons (Fcons (make_int (n), obj),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 Vread_objects);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 else if (c == '#')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 /* #n# returns a previously read object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 if (CONSP (found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 return XCDR (found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 list2 (build_translated_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 ("Undefined symbol label"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 make_int (n)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 default:
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 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 /* Quote */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 case '\'': return list2 (Qquote, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 case '`':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 ++new_backquote_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 record_unwind_protect (backquote_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 make_opaque_ptr (&new_backquote_flag));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 tem = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 return list2 (Qbackquote, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 }
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 case ',':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 if (new_backquote_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 Lisp_Object comma_type = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 int ch = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 if (ch == '@')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 comma_type = Qcomma_at;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 else if (ch == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 comma_type = Qcomma_dot;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 else
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 if (ch >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 comma_type = Qcomma;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 return list2 (comma_type, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 /* YUCK. 99.999% backwards compatibility. The Right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 Thing(tm) is to signal an error here, because it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 really invalid read syntax. Instead, this permits
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 commas to begin symbols (unless they're inside
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 backquotes). If an error is signalled here in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 future, then commas should be invalid read syntax
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 outside of backquotes anywhere they're found (i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 they must be quoted in symbols) -- Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 return read_atom (readcharfun, c, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 }
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 case '?':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 /* Evil GNU Emacs "character" (ie integer) syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 return make_char (c);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 case '\"':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 /* String */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 /* #### If the input stream is translating, then the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 should be marked as translatable by setting its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 `string-translatable' property to t. .el and .elc files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 normally are translating input streams. See Fgettext()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 and print_internal(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 int cancel = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 while ((c = readchar (readcharfun)) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 && c != '\"')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 /* c is -1 if \ newline has just been seen */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 if (c == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 cancel = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
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 /* If purifying, and string starts with \ newline,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 return zero instead. This is for doc strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 that we are really going to find in lib-src/DOC.nn.nn */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 Lstream_flush (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 make_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 /* Ignore whitespace and control characters */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 if (c <= 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 return read_atom (readcharfun, c, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 }
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 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 #define LEAD_INT 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 #define DOT_CHAR 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 #define TRAIL_INT 4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 #define E_CHAR 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 #define EXP_INT 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2701 isfloat_string (const char *cp)
428
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 int state = 0;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2704 const Intbyte *ucp = (const Intbyte *) cp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 if (*ucp == '+' || *ucp == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 if (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 state |= LEAD_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 if (*ucp == '.')
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 state |= DOT_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 if (*ucp >= '0' && *ucp <= '9')
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 state |= TRAIL_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 if (*ucp == 'e' || *ucp == 'E')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 state |= E_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 if ((*ucp == '+') || (*ucp == '-'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 if (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 state |= EXP_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 || (*ucp == '\r') || (*ucp == '\f'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 || state == (DOT_CHAR|TRAIL_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 || state == (LEAD_INT|E_CHAR|EXP_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 static void *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 sequence_reader (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 Emchar terminator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 void *state,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 void * (*conser) (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 void *state, Charcount len))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 Charcount len;
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 for (len = 0; ; len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 Emchar ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 if (ch == terminator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 return state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 if (ch == ']')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2772 read_syntax_error ("\"]\" in a list");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 else if (ch == ')')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2774 read_syntax_error ("\")\" in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 state = ((conser) (readcharfun, state, len));
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779
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 struct read_list_state
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 Lisp_Object head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 int length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 int allow_dotted_lists;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 Emchar terminator;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 static void *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 struct read_list_state *s = (struct read_list_state *) state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 Lisp_Object elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 elt = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 Lisp_Object tem = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 Emchar ch;
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 elt = XCDR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 free_cons (XCONS (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 ch = XCHAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 if (ch == s->terminator) /* deal with #+, #- reader macros */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 unreadchar (readcharfun, s->terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 else if (ch == ']')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2814 read_syntax_error ("']' in a list");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 else if (ch == ')')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2816 read_syntax_error ("')' in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 if (ch != '.')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2820 signal_error (Qinternal_error, "BUG! Internal reader error", elt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 else if (!s->allow_dotted_lists)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2822 read_syntax_error ("\".\" in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 if (!NILP (s->tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 XCDR (s->tail) = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 s->head = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 elt = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 ch = XCHAR (XCDR (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 free_cons (XCONS (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 if (ch == s->terminator)
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 unreadchar (readcharfun, s->terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2840 read_syntax_error (". in wrong context");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 #if 0 /* FSFmacs defun hack, or something ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 record_unwind_protect (unreadpure, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 read_pure = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 Vcurrent_compiled_function_annotation = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 elt = Fcons (elt, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 if (!NILP (s->tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 XCDR (s->tail) = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 s->head = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 s->tail = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 s->length++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 return s;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 #if 0 /* FSFmacs defun hack */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 /* -1 for allow_dotted_lists means allow_dotted_lists and check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 for starting with defun and make structure pure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 read_list (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 Emchar terminator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 int allow_dotted_lists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 int check_for_doc_references)
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 struct read_list_state s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 Lisp_Object old_compiled_function_annotation =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 Vcurrent_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 s.head = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 s.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 s.length = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 s.allow_dotted_lists = allow_dotted_lists;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 s.terminator = terminator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 GCPRO2 (s.head, s.tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
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 /* check now for any doc string references and record them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 for later. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 Lisp_Object tail;
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 /* We might be dealing with an imperfect list so don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 use LIST_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 Lisp_Object holding_cons = Qnil;
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 Lisp_Object elem = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 /* elem might be (#$ . INT) ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 holding_cons = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 /* or it might be (quote (#$ . INT)) i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 (quote . ((#$ . INT) . nil)) in the case of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 `autoload' (autoload evaluates its arguments, while
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 `defvar', `defun', etc. don't). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 && CONSP (XCDR (elem)))
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 elem = XCAR (XCDR (elem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 holding_cons = XCDR (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 if (CONSP (holding_cons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 if (purify_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 if (NILP (Vinternal_doc_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 /* We have not yet called Snarf-documentation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 assume this file is described in the DOC file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 and Snarf-documentation will fill in the right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 value later. For now, replace the whole list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 with 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 XCAR (holding_cons) = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 /* We have already called Snarf-documentation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 make a relative file name for this file, so it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 can be found properly in the installed Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 directory. We don't use Fexpand_file_name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 because that would make the directory absolute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 XCAR (XCAR (holding_cons)) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 concat2 (build_string ("../lisp/"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 Ffile_name_nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 (Vload_file_name_internal));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 /* Not pure. Just add to Vload_force_doc_string_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 and the string will be filled in properly in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 load_force_doc_string_unwind(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 Vload_force_doc_string_list =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 /* We pass the cons that holds the (#$ . INT) so we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 can modify it in-place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 Fcons (holding_cons, Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 return s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 read_vector (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 Emchar terminator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 Lisp_Object *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 struct read_list_state s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 struct gcpro gcpro1, gcpro2;
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 s.head = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 s.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 s.length = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 s.allow_dotted_lists = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 GCPRO2 (s.head, s.tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 tem = s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 len = XINT (Flength (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 #if 0 /* FSFmacs defun hack */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 if (read_pure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 s.head = make_pure_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 s.head = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 i < len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 i++, p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
3007 Lisp_Cons *otem = XCONS (tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 tem = Fcar (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 *p = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 tem = otem->cdr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 free_cons (otem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 return s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
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 /* Accept compiled functions at read-time so that we don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 have to build them at load-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 Lisp_Object stuff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 int iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 int saw_a_doc_ref = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 /* Note: we tell read_list not to search for doc references
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 because we need to handle the "doc reference" for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 instructions and constants differently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 stuff = read_list (readcharfun, terminator, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 len = XINT (Flength (stuff));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 return
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3035 continuable_read_syntax_error ("#[...] used with wrong number of elements");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 for (iii = 0; CONSP (stuff); iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
3039 Lisp_Cons *victim = XCONS (stuff);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 make_byte_code_args[iii] = Fcar (stuff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 if ((purify_flag || load_force_doc_strings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 && CONSP (make_byte_code_args[iii])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 if (purify_flag && iii == COMPILED_DOC_STRING)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 /* same as in read_list(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 if (NILP (Vinternal_doc_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 make_byte_code_args[iii] = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 XCAR (make_byte_code_args[iii]) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 concat2 (build_string ("../lisp/"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 Ffile_name_nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 (Vload_file_name_internal));
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 saw_a_doc_ref = 1;
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 stuff = Fcdr (stuff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 free_cons (victim);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 GCPRO1 (make_byte_code_args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 gcpro1.nvars = len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 ebolify_bytecode_constants (make_byte_code_args[2]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 /* make-byte-code looks at purify_flag, which should have the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 * value as our "read-pure" argument */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 stuff = Fmake_byte_code (len, make_byte_code_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 if (saw_a_doc_ref)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 return stuff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 init_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 Vvalues = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 load_in_progress = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 Vload_descriptor_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 /* kludge: locate-file does not work for a null load-path, even if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 the file name is absolute. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 Vload_path = Fcons (build_string (""), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 /* This used to get initialized in init_lread because all streams
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 got closed when dumping occurs. This is no longer true --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 Vread_buffer_stream is a resizing output stream, and there is no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 reason to close it at dump-time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 will initialize it only once, at dump-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 if (NILP (Vread_buffer_stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 Vload_force_doc_string_list = Qnil;
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 syms_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 DEFSUBR (Fread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 DEFSUBR (Fread_from_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 DEFSUBR (Fload_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 DEFSUBR (Flocate_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 DEFSUBR (Flocate_file_clear_hashing);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 DEFSUBR (Feval_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 DEFSUBR (Feval_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3119 DEFSYMBOL (Qstandard_input);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3120 DEFSYMBOL (Qread_char);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3121 DEFSYMBOL (Qcurrent_load_list);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3122 DEFSYMBOL (Qload);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3123 DEFSYMBOL (Qload_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3124 DEFSYMBOL (Qfset);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 #ifdef LISP_BACKQUOTES
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3127 DEFSYMBOL (Qbackquote);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 defsymbol (&Qbacktick, "`");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 defsymbol (&Qcomma, ",");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 defsymbol (&Qcomma_at, ",@");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 defsymbol (&Qcomma_dot, ",.");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3134 DEFSYMBOL (Qexists);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3135 DEFSYMBOL (Qreadable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3136 DEFSYMBOL (Qwritable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3137 DEFSYMBOL (Qexecutable);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 structure_type_create (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 the_structure_type_dynarr = Dynarr_new (structure_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 reinit_vars_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 Vread_buffer_stream = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 staticpro_nodump (&Vread_buffer_stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 vars_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 reinit_vars_of_lread ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 DEFVAR_LISP ("values", &Vvalues /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 List of values of all expressions which were read, evaluated and printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 Order is reverse chronological.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 Stream for read to get input from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 See documentation of `read' for possible values.
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 Vstandard_input = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 DEFVAR_LISP ("load-path", &Vload_path /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 *List of directories to search for files to load.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 Each element is a string (directory name) or nil (try default directory).
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 Note that the elements of this list *may not* begin with "~", so you must
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 call `expand-file-name' on them before adding them to this list.
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 Initialized based on EMACSLOADPATH environment variable, if any,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 otherwise to default specified in by file `paths.h' when XEmacs was built.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 If there were no paths specified in `paths.h', then XEmacs chooses a default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 value for this variable by looking around in the file-system near the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 directory in which the XEmacs executable resides.
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 Vload_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 "*Location of lisp files to be used when dumping ONLY."); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 Non-nil iff inside of `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 */ );
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 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 An alist of expressions to be evalled when particular files are loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 Each element looks like (FILENAME FORMS...).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 When `load' is run and the file-name argument is FILENAME,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 the FORMS in the corresponding element are executed at the end of loading.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 FILENAME must match exactly! Normally FILENAME is the name of a library,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 with no directory specified, since that is how `load' is normally called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 An error in FORMS does not undo the load,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 but does prevent execution of the rest of the FORMS.
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 Vafter_load_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 *Whether `load' should check whether the source is newer than the binary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 If this variable is true, then when a `.elc' file is being loaded and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 corresponding `.el' is newer, a warning message will be printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 load_warn_when_source_newer = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 If this variable is true, then when `load' is called with a filename without
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 then a message will be printed. If an explicit extension is passed to `load',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 no warning will be printed.
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 load_warn_when_source_only = 0;
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 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 *Whether `load' should ignore `.elc' files when a suffix is not given.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 load_ignore_elc_files = 0;
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 #ifdef LOADHIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 DEFVAR_LISP ("load-history", &Vload_history /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 Alist mapping source file names to symbols and features.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 Each alist element is a list that starts with a file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 except for one element (optional) that starts with nil and describes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 definitions evaluated from buffers not visiting files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 The remaining elements of each list are symbols defined as functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 Vload_history = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 Used for internal purposes by `load'.
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 Vcurrent_load_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 Full name of file being loaded by `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 Vload_file_name = Qnil;
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 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 Function used by `load' and `eval-region' for reading expressions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 The default is nil, which means use the function `read'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 Vload_read_function = Qnil;
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 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 Non-nil means `load' should force-load all dynamic doc strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 This is useful when the file being loaded is a temporary copy.
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 load_force_doc_strings = 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 /* See read_escape(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 /* Used to be named `puke-on-fsf-keys' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 &fail_on_bucky_bit_character_escapes /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 Whether `read' should signal an error when it encounters unsupported
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 character escape syntaxes or just read them incorrectly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 fail_on_bucky_bit_character_escapes = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 /* This must be initialized in init_lread otherwise it may start out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 with values saved when the image is dumped. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 staticpro (&Vload_descriptor_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 /* Initialized in init_lread. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 staticpro (&Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 Vload_file_name_internal = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 staticpro (&Vload_file_name_internal);
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 Vload_file_name_internal_the_purecopy = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 staticpro (&Vload_file_name_internal_the_purecopy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 staticpro (&Vcurrent_compiled_function_annotation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 #endif
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 /* So that early-early stuff will work */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 Ffset (Qload, intern ("load-internal"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 #ifdef FEATUREP_SYNTAX
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3293 DEFSYMBOL (Qfeaturep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 Fprovide(intern("xemacs"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 #ifdef INFODOCK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 Fprovide(intern("infodock"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 #endif /* INFODOCK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 #endif /* FEATUREP_SYNTAX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 old_backquote_flag = new_backquote_flag = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 #endif
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 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 Vfile_domain = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 #endif
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 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 staticpro (&Vread_objects);
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 Vlocate_file_hash_table = make_lisp_hash_table (200,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 HASH_TABLE_NON_WEAK,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 HASH_TABLE_EQUAL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 staticpro (&Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 = Vlocate_file_hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 }