annotate src/lread.c @ 1292:f3437b56874d

[xemacs-hg @ 2003-02-13 09:57:04 by ben] profile updates profile.c: Major reworking. Keep track of new information -- total function timing (includes descendants), GC usage, total GC usage (includes descendants). New functions to be called appropriately from eval.c, alloc.c to keep track of this information. Keep track of when we're actually in a function vs. in its profile, for more accurate timing counts. Track profile overhead separately. Create new mechanism for specifying "internal sections" that are tracked just like regular Lisp functions and even appear in the backtrace if `backtrace-with-internal-sections' is non-nil (t by default for error-checking builds). Add some KKCC information for the straight (non-Elisp) hash table used by profile, which contains Lisp objects in its keys -- but not used yet. Remove old ad-hoc methods for tracking garbage collection, redisplay (which was incorrect anyway when Lisp was called within these sections). Don't record any tick info when blocking under MS Windows, since the timer there is in real time rather than in process time. Make `start-profiling', `stop-profiling' interactive. Be consistent wrt. recursive functions and functions currently on the stack when starting or stopping -- together these make implementing the `total' values extremely difficult. When we start profiling, we act as if we just entered all the functions currently on the stack. Likewise when exiting. Create vars in_profile for tracking time spent inside of profiling, and profiling_lock for setting exclusive access to the main hash table when reading from it or modifying it. (protects against getting screwed up by the signal handle going off at the same time. profile.h: New file. Create macros for declaring internal profiling sections. lisp.h: Move profile-related stuff to profile.h. alloc.c: Keep track of total consing, for profile. Tell profile when we are consing. Use new profile-section method for noting garbage-collection. alloc.c: Abort if we attempt to call the allocator reentrantly. backtrace.h, eval.c: Add info for use by profile in the backtrace frame and transfer PUSH_BACKTRACE/POP_BACKTRACE from eval.c, for use with profile. elhash.c: Author comment. eval.c, lisp.h: New Lisp var `backtrace-with-internal-sections'. Set to t when error-checking is on. eval.c: When unwinding, eval.c: Report to profile when we are about-to-call and just-called wrt. a function. alloc.c, eval.c: Allow for "fake" backtrace frames, for internal sections (used by profile and `backtrace-with-internal-sections'. event-Xt.c, event-gtk.c, event-msw.c, event-tty.c: Record when we are actually blocking on an event, for profile's sake. event-stream.c: Record internal profiling sections for getting, dispatching events. extents.c: Record internal profiling sections for map_extents. hash.c, hash.h: Add pregrow_hash_table_if_necessary(). (Used in profile code since the signal handler is the main grower but can't allow a realloc(). We make sure, at critical points, that the table is large enough.) lread.c: Create internal profiling sections for `load' (which may be triggered internally by autoload, etc.). redisplay.c: Remove old profile_redisplay_flag. Use new macros to declare internal profiling section for redisplay. text.c: Use new macros to declare internal profiling sections for char-byte conversion and internal-external conversion. SEMI-UNRELATED CHANGES: ----------------------- text.c: Update the long comments.
author ben
date Thu, 13 Feb 2003 09:57:08 +0000
parents 57b76886836d
children 21549d437f09
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.
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
4 Copyright (C) 1996, 2001, 2002, 2003 Ben Wing.
428
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"
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
33 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "opaque.h"
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
36 #include "profile.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "sysfloat.h"
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
40 #ifdef WIN32_NATIVE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
41 #include "syswindows.h"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
42 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 Lisp_Object Qread_char, Qstandard_input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 Lisp_Object Qvariable_documentation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #define LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 Nonzero means inside a new-style backquote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 with no surrounding parentheses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 Fread initializes this to zero, so we need not specbind it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 or worry about what happens to it when there is an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 XEmacs:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 Nested backquotes are perfectly legal and fail utterly with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 this silliness. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 static int new_backquote_flag, old_backquote_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 Lisp_Object Qvariable_domain; /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Qcurrent_load_list;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
63 Lisp_Object Qload, Qload_file_name, Qload_internal, Qfset;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 /* Hash-table that maps directory names to hashes of their contents. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 static Lisp_Object Vlocate_file_hash_table;
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 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 /* See read_escape() for an explanation of this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 int fail_on_bucky_bit_character_escapes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 /* This symbol is also used in fns.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 #define FEATUREP_SYNTAX
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 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Lisp_Object Qfeaturep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 /* non-zero if inside `load' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 int load_in_progress;
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 /* Whether Fload_internal() should check whether the .el is newer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 when loading .elc */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 int load_warn_when_source_newer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 /* Whether Fload_internal() should check whether the .elc doesn't exist */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 int load_warn_when_source_only;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 int load_ignore_elc_files;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
92 /* Whether Fload_internal() should ignore out-of-date .elc files when no
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
93 suffix is given */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
94 int load_ignore_out_of_date_elc_files;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
95 /* Always display messages showing when a file is loaded, regardless of
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
96 whether the flag to `load' tries to suppress them. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
97 int load_always_display_messages;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
98 /* Show the full path in loading messages. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
99 int load_show_full_path_in_messages;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 /* Search path for files to be loaded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Lisp_Object Vload_path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 /* Search path for files when dumping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 /* Lisp_Object Vdump_load_path; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 /* This is the user-visible association list that maps features to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 lists of defs in their load files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Lisp_Object Vload_history;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 /* This is used to build the load history. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Lisp_Object Vcurrent_load_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 /* Name of file actually being read by `load'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Lisp_Object Vload_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 our #$ checks are reliable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Lisp_Object Vload_file_name_internal;
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 Lisp_Object Vload_file_name_internal_the_purecopy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 /* Function to use for reading, in `load' and friends. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Lisp_Object Vload_read_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 /* The association list of objects read with the #n=object form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 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
128 look up the object for the corresponding #n# construct.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 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
130 Lisp_Object Vread_objects;
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 /* Nonzero means load should forcibly load all dynamic doc strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 /* Note that this always happens (with some special behavior) when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 purify_flag is set. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 static int load_force_doc_strings;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 /* List of descriptors now open for Fload_internal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 static Lisp_Object Vload_descriptor_list;
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 /* In order to implement "load_force_doc_strings", we keep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 a list of all the compiled-function objects and such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 that we have created in the process of loading this file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 See the rant below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 We specbind this just like Vload_file_name, so there's no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 problems with recursive loading. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 static Lisp_Object Vload_force_doc_string_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 /* A resizing-buffer stream used to temporarily hold data while reading */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 static Lisp_Object Vread_buffer_stream;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Lisp_Object Vcurrent_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 #endif
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 static int load_byte_code_version;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 /* An array describing all known built-in structure types */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 static structure_type_dynarr *the_structure_type_dynarr;
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
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
198 doc strings at once. --ben */
428
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
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
210 static int locate_file_open_or_access_file (Ibyte *fn, int access_mode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 EXFUN (Fread_from_string, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 /* When errors are signaled, the actual readcharfun should not be used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 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
215 to the Lisp level. */
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
216 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
217 ? (build_msg_string ("internal input stream")) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 : (x))
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 static DOESNT_RETURN
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
222 read_syntax_error (const char *string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
224 signal_error (Qinvalid_read_syntax, string, Qunbound);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
228 continuable_read_syntax_error (const char *string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
230 return signal_continuable_error (Qinvalid_read_syntax, string, Qunbound);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 /* Handle unreading and rereading of characters. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
235 static Ichar
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 readchar (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
242 Ichar c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 struct buffer *b = XBUFFER (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 if (!BUFFER_LIVE_P (b))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
246 invalid_operation ("Reading from killed buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 if (BUF_PT (b) >= BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 c = BUF_FETCH_CHAR (b, BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 BUF_SET_PT (b, BUF_PT (b) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 else if (LSTREAMP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
257 Ichar c = Lstream_get_ichar (XLSTREAM (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 #ifdef DEBUG_XEMACS /* testing Mule */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 static int testing_mule = 0; /* Change via debugger */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
260 if (testing_mule)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
261 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
262 if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
263 else if (c == '\n') stderr_out ("\\n\n");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
264 else stderr_out ("\\%o ", c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
265 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
266 #endif /* testing Mule */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
271 Ichar c;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
272 Charbpos mpos = marker_position (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 if (mpos >= BUF_ZV (inbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 c = BUF_FETCH_CHAR (inbuffer, mpos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 set_marker_position (readcharfun, mpos + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Lisp_Object tem = call0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 if (!CHAR_OR_CHAR_INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 return XCHAR_OR_CHAR_INT (tem);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 /* Unread the character C in the way appropriate for the stream READCHARFUN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 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
293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 static void
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
295 unreadchar (Lisp_Object readcharfun, Ichar c)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 if (c == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 /* 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
299 since readchar didn't advance it when we read it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 else if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 else if (LSTREAMP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
305 Lstream_unget_ichar (XLSTREAM (readcharfun), c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 #ifdef DEBUG_XEMACS /* testing Mule */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 static int testing_mule = 0; /* Set this using debugger */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 if (testing_mule)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 fprintf (stderr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 call1 (readcharfun, make_char (c));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 static Lisp_Object read0 (Lisp_Object readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 static Lisp_Object read1 (Lisp_Object readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 static Lisp_Object read_list (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
325 Ichar terminator,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 int allow_dotted_lists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 int check_for_doc_references);
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 static void readevalloop (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Lisp_Object sourcefile,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 Lisp_Object (*evalfun) (Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 int printflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 Lstream_close (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 /* The plague is coming.
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 Ring around the rosy, pocket full of posy,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 Ashes ashes, they all fall down.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 ebolify_bytecode_constants (Lisp_Object vector)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 int len = XVECTOR_LENGTH (vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Lisp_Object el = XVECTOR_DATA (vector)[i];
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 /* We don't check for `eq', `equal', and the others that have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 bytecode opcodes. This might lose if someone passes #'eq or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 something to `funcall', but who would really do that? As
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 they say in law, we've made a "good-faith effort" to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 unfuckify ourselves. And doing it this way avoids screwing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 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
362 add an extra Ebola check in decode_weak_list_type(). --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 if (EQ (el, Qassoc)) el = Qold_assoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 else if (EQ (el, Qdelq)) el = Qold_delq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 /* I think this is a bad idea because it will probably mess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 with keymap code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 else if (EQ (el, Qdelete)) el = Qold_delete;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 else if (EQ (el, Qrassq)) el = Qold_rassq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 XVECTOR_DATA (vector)[i] = el;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 }
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 static Lisp_Object
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
378 pas_de_holgazan_ici (int fd, Lisp_Object victim)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 EMACS_INT pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 if (!INTP (XCDR (victim)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
384 invalid_byte_code ("Bogus doc string reference", victim);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 pos = XINT (XCDR (victim));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 if (pos < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 pos = -pos; /* kludge to mark a user variable */
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
388 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 if (!STRINGP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
390 signal_error_1 (Qinvalid_byte_code, tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 return tem;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 load_force_doc_string_unwind (Lisp_Object oldlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 Lisp_Object list = Vload_force_doc_string_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 int fd = XINT (XCAR (Vload_descriptor_list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 GCPRO1 (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 /* restore the old value first just in case an error occurs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 Vload_force_doc_string_list = oldlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 LIST_LOOP (tail, list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 Lisp_Object john = Fcar (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 if (CONSP (john))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 assert (CONSP (XCAR (john)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 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
413 XCAR (john) = pas_de_holgazan_ici (fd, XCAR (john));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 else
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 Lisp_Object doc;
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 assert (COMPILED_FUNCTIONP (john));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 struct gcpro ngcpro1;
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
423 Lisp_Object juan = (pas_de_holgazan_ici
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
424 (fd,
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
425 XCOMPILED_FUNCTION (john)->instructions));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 Lisp_Object ivan;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 NGCPRO1 (juan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 ivan = Fread (juan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 if (!CONSP (ivan))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
431 invalid_byte_code ("invalid lazy-loaded byte code", ivan);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 if (XCOMPILED_FUNCTION (john)->flags.ebolified
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 && VECTORP (XCDR (ivan)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 ebolify_bytecode_constants (XCDR (ivan));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 if (CONSP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 assert (!purify_flag); /* should have been handled in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 read_compiled_function() */
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
445 doc = pas_de_holgazan_ici (fd, doc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 if (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 free_list (list);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 /* Close all descriptors in use for Fload_internal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 This is used when starting a subprocess. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 close_load_descs (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 LIST_LOOP (tail, Vload_descriptor_list)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
467 retry_close (XINT (XCAR (tail)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 Lisp_Object Vfile_domain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 #endif /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 Execute a file of Lisp code named FILE; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 This function is identical to `load' except for the handling of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 support is not present, both functions are identical and ignore the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 CODESYS and USED-CODESYS arguments.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 If support for Mule exists in this Emacs, the file is decoded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 according to CODESYS; if omitted, no conversion happens. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 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
484 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
485 general be different from CODESYS if CODESYS specifies automatic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 encoding detection or end-of-line detection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
488 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 int fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 int source_only = 0;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
494 /* NEWER and OLDER are filenames w/o directory, used in loading messages
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
495 to e.g. warn of newer .el files when the .elc is being loaded. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 Lisp_Object newer = Qnil;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
497 Lisp_Object older = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 Lisp_Object handler = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 Lisp_Object found = Qnil;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
500 Lisp_Object retval;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
501 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 int reading_elc = 0;
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
503 int from_require = EQ (nomessage, Qrequire);
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
504 int message_p = NILP (nomessage) || load_always_display_messages;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 struct stat s1, s2;
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
506 Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10);
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
507 int i;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
508 PROFILE_DECLARE ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
1266
b5a5863da615 [xemacs-hg @ 2003-02-07 00:54:17 by ben]
ben
parents: 1261
diff changeset
510 GCPRO4 (file, newer, older, found);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 CHECK_STRING (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
513 PROFILE_RECORD_ENTERING_SECTION (Qload_internal);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
514
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 /* If file name is magic, call the handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 handler = Ffind_file_name_handler (file, Qload);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 if (!NILP (handler))
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
518 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
519 retval = call5 (handler, Qload, file, noerror, nomessage, nosuffix);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
520 goto done;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
521 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 /* Do this after the handler to avoid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 the need to gcpro noerror, nomessage and nosuffix.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (Below here, we care only whether they are nil or not.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 file = Fsubstitute_in_file_name (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 CHECK_SYMBOL (used_codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
530 if (noninteractive)
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
531 {
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
532 for (i = 0; i < load_in_progress * 2; i++)
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
533 spaces[i] = ' ';
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
534 spaces[i] = '\0';
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
535 }
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
536 else
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
537 spaces[0] = '\0';
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
538
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 /* Avoid weird lossage with null string as arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 since it would try to load a directory as a Lisp file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 Unix truly sucks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 if (XSTRING_LENGTH (file) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
544 Ibyte *foundstr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 int foundlen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 fd = locate_file (Vload_path, file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 ((!NILP (nosuffix)) ? Qnil :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 build_string (load_ignore_elc_files ? ".el:" :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 ".elc:.el:")),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 &found,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
556 if (NILP (noerror))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
557 signal_error (Qfile_error, "Cannot open load file", file);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
560 retval = Qnil;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
561 goto done;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
565 foundstr = (Ibyte *) ALLOCA (XSTRING_LENGTH (found) + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
566 qxestrcpy (foundstr, XSTRING_DATA (found));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
567 foundlen = qxestrlen (foundstr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 /* The omniscient JWZ thinks this is worthless, but I beg to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 differ. --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 if (load_ignore_elc_files)
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
572 newer = Ffile_name_nondirectory (found);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
573 else if ((load_warn_when_source_newer ||
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
574 load_ignore_out_of_date_elc_files) &&
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 !memcmp (".elc", foundstr + foundlen - 4, 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
577 if (! qxe_fstat (fd, &s1)) /* can't fail, right? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 int result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 /* temporarily hack the 'c' off the end of the filename */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 foundstr[foundlen - 1] = '\0';
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
582 result = qxe_stat (foundstr, &s2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 if (result >= 0 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
585 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
586 /* .elc exists and is out-of-date wrt .el */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
587 Lisp_Object el_name = make_string (foundstr, foundlen - 1);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
588 struct gcpro nngcpro1;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
589 NNGCPRO1 (el_name);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
590 newer = Ffile_name_nondirectory (el_name);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
591 if (load_ignore_out_of_date_elc_files)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
592 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
593 int newfd =
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
594 locate_file_open_or_access_file
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
595 (XSTRING_DATA (el_name), -1);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
596
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
597 if (newfd >= 0)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
598 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
599 older = Ffile_name_nondirectory (found);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
600 found = el_name;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
601 retry_close (fd);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
602 fd = newfd;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
603 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
604 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
605 NNUNGCPRO;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
606 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 /* put the 'c' back on (kludge-o-rama) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 foundstr[foundlen - 1] = 'c';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 else if (load_warn_when_source_only &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 /* `found' ends in ".el" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 !memcmp (".el", foundstr + foundlen - 3, 3) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 /* `file' does not end in ".el" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 memcmp (".el",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 3))
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
618 source_only = 1;
428
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 (!memcmp (".elc", foundstr + foundlen - 4, 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 reading_elc = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
624 #define PRINT_LOADING_MESSAGE_1(loading, done) \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
625 do { \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
626 if (load_ignore_elc_files) \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
627 { \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
628 if (message_p) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
629 message (loading done, spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
630 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
631 found : newer)); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
632 } \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
633 else if (!NILP (older)) \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
634 { \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
635 assert (load_ignore_out_of_date_elc_files); \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
636 message (loading done " (file %s is out-of-date)", spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
637 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
638 found : newer), \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
639 XSTRING_DATA (older)); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
640 } \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
641 else if (!NILP (newer)) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
642 message (loading done " (file %s is newer)", spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
643 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
644 found : file), \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
645 XSTRING_DATA (newer)); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
646 else if (source_only) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
647 message (loading done " (file %s.elc does not exist)", spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
648 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
649 found : file), \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
650 XSTRING_DATA (Ffile_name_nondirectory (file))); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
651 else if (message_p) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
652 message (loading done, spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
653 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
654 found : file)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
657 #define PRINT_LOADING_MESSAGE(done) \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
658 do { \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
659 if (from_require) \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
660 PRINT_LOADING_MESSAGE_1 ("%sRequiring %s...", done); \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
661 else \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
662 PRINT_LOADING_MESSAGE_1 ("%sLoading %s...", done); \
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
663 } while (0)
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
664
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 PRINT_LOADING_MESSAGE ("");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 /* Lisp_Object's must be malloc'ed, not stack-allocated */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 Lisp_Object lispstream = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
670 const int block_size = 8192;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 struct gcpro ngcpro1;
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 NGCPRO1 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 /* 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
676 files aren't really all that big. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 block_size);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
679 lispstream = make_coding_input_stream
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
680 (XLSTREAM (lispstream), get_coding_system_for_text_file (codesys, 1),
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
681 CODING_DECODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 block_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 /* NOTE: Order of these is very important. Don't rearrange them. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
685 internal_bind_int (&load_in_progress, 1 + load_in_progress);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 record_unwind_protect (load_unwind, lispstream);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
687 internal_bind_lisp_object (&Vload_descriptor_list,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
688 Fcons (make_int (fd), Vload_descriptor_list));
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
689 internal_bind_lisp_object (&Vload_file_name_internal, found);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
690 internal_bind_lisp_object (&Vload_file_name_internal_the_purecopy, Qnil);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
691 /* this is not a simple internal_bind. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 record_unwind_protect (load_force_doc_string_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 Vload_force_doc_string_list);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
694 Vload_force_doc_string_list = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 specbind (Qload_file_name, found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 #ifdef I18N3
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
697 /* set it to nil; a call to #'domain will set it. */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
698 internal_bind_lisp_object (&Vfile_domain, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 /* Now determine what sort of ELC file we're reading in. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
702 internal_bind_int (&load_byte_code_version, load_byte_code_version);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 if (reading_elc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 char elc_header[8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 int num_read;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 if (num_read < 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 || strncmp (elc_header, ";ELC", 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 /* Huh? Probably not a valid ELC file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 load_byte_code_version = 100; /* no Ebolification needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 load_byte_code_version = elc_header[4];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 load_byte_code_version = 100; /* no Ebolification needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 readevalloop (lispstream, file, Feval, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 Fset (used_codesys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 XCODING_SYSTEM_NAME
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
726 (coding_stream_detected_coding_system (XLSTREAM (lispstream))));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
727 unbind_to (speccount);
428
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 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 /* #### Disgusting kludge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 /* Run any load-hooks for this file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 /* #### An even more disgusting kludge. There is horrible code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 /* that is relying on the fact that dumped lisp files are found */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 /* via `load-path' search. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 Lisp_Object name = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
741 if (!NILP (Ffile_name_absolute_p (file)))
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
742 name = Ffile_name_nondirectory (file);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
744 tem = Fassoc (name, Vafter_load_alist);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 if (!NILP (tem))
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 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 NGCPRO1 (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 tem = Fcons (Qprogn, Fcdr (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 Feval (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 if (!noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 PRINT_LOADING_MESSAGE ("done");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
760 retval = Qt;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
761 done:
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
762 PROFILE_RECORD_EXITING_SECTION (Qload_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 UNGCPRO;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
764 return retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
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 /* ------------------------------- */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 /* locate_file */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 /* ------------------------------- */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 decode_mode_1 (Lisp_Object mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 if (EQ (mode, Qexists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 return F_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 else if (EQ (mode, Qexecutable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 return X_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 else if (EQ (mode, Qwritable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 return W_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 else if (EQ (mode, Qreadable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 return R_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 else if (INTP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 check_int_range (XINT (mode), 0, 7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 return XINT (mode);
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 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
789 invalid_argument ("Invalid value", mode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 return 0; /* unreached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 decode_mode (Lisp_Object mode)
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 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 return R_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 else if (CONSP (mode))
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 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 int mask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 EXTERNAL_LIST_LOOP (tail, mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 mask |= decode_mode_1 (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 return mask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 return decode_mode_1 (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 Search for FILENAME through PATH-LIST.
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 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
814 file name when searching.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 If 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
817 requirements. Allowed symbols are `exists', `executable', `writable', and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 `readable'. If MODE is nil, it defaults to `readable'.
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 `locate-file' keeps hash tables of the directories it searches through,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 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
822 the face of a changing and unpredictable environment, but can occasionally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 get tripped up. In this case, you will have to call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 `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
825 for details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 (filename, path_list, suffixes, mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 Lisp_Object tp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 CHECK_STRING (filename);
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 if (LISTP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 EXTERNAL_LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 CHECK_STRING (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 CHECK_STRING (suffixes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 return tp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 /* Recalculate the hash table for the given string. DIRECTORY should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 better have been through Fexpand_file_name() by now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 locate_file_refresh_hashing (Lisp_Object directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 Lisp_Object hash =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
854 make_directory_hash_table (XSTRING_DATA (directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 if (!NILP (hash))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 Fputhash (directory, hash, Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 return hash;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 /* find the hash table for the given directory, recalculating if necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 locate_file_find_directory_hash_table (Lisp_Object directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 if (NILP (hash))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 return locate_file_refresh_hashing (directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 /* The SUFFIXES argument in any of the locate_file* functions can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 nil, a list, or a string (for backward compatibility), with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 following semantics:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 a) nil - no suffix, just search for file name intact
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (semantically different from "empty suffix list", which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 would be meaningless.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 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
881 must be a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 c) string - colon-separated suffixes to append to file name (backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 compatibility).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 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
886 function for each suffix shouldn't slow things down, since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 locate_file is rarely called with enough suffixes for funcalls to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 make any difference. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 /* 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
891 char * containing the current file name, and ARG. Mapping stops when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 FUN returns non-zero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
895 int (*fun) (Ibyte *, void *),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
899 Ibyte *fn;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 int fn_len, max;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 /* Calculate maximum size of any filename made from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 this path element/specified file name and any possible suffix. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 if (CONSP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 /* We must traverse the list, so why not do it right. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 max = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 if (XSTRING_LENGTH (XCAR (tail)) > max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 max = XSTRING_LENGTH (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 else if (NILP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 max = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 /* Just take the easy way out */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 max = XSTRING_LENGTH (suffixes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 fn_len = XSTRING_LENGTH (filename);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
922 fn = (Ibyte *) ALLOCA (max + fn_len + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
923 memcpy (fn, XSTRING_DATA (filename), fn_len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 /* Loop over suffixes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 if (!STRINGP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 if (NILP (suffixes))
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 /* Case a) discussed in the comment above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 fn[fn_len] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 /* Case b) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 XSTRING_LENGTH (XCAR (tail)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 }
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 /* Case c) */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
952 const Ibyte *nsuffix = XSTRING_DATA (suffixes);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
956 Ibyte *esuffix = qxestrchr (nsuffix, ':');
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
957 Bytecount lsuffix = esuffix ? esuffix - nsuffix :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
958 qxestrlen (nsuffix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 /* Concatenate path element/specified name with the suffix. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
961 qxestrncpy (fn + fn_len, nsuffix, lsuffix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 fn[fn_len + lsuffix] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 /* Advance to next suffix. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 if (esuffix == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 nsuffix += lsuffix + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
975 struct locate_file_in_directory_mapper_closure
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
976 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 Lisp_Object *storeptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
982 /* open() or access() a file to be returned by locate_file(). if
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
983 ACCESS_MODE >= 0, do an access() with that mode, else open(). Does
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
984 various magic, e.g. opening the file read-only and binary and setting
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
985 the close-on-exec flag on the file. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
986
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
987 static int
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
988 locate_file_open_or_access_file (Ibyte *fn, int access_mode)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
989 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
990 int val;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
991
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
992 /* Check that we can access or open it. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
993 if (access_mode >= 0)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
994 val = qxe_access (fn, access_mode);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
995 else
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
996 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
997 val = qxe_open (fn, O_RDONLY | OPEN_BINARY, 0);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
998
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
999 #ifndef WIN32_NATIVE
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1000 if (val >= 0)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1001 /* If we actually opened the file, set close-on-exec flag
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1002 on the new descriptor so that subprocesses can't whack
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1003 at it. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1004 (void) fcntl (val, F_SETFD, FD_CLOEXEC);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1005 #endif
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1006 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1007
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1008 return val;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1009 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1010
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1012 locate_file_in_directory_mapper (Ibyte *fn, void *arg)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 struct locate_file_in_directory_mapper_closure *closure =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1015 (struct locate_file_in_directory_mapper_closure *) arg;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 /* Ignore file if it's a directory. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1019 if (qxe_stat (fn, &st) >= 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 && (st.st_mode & S_IFMT) != S_IFDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 /* Check that we can access or open it. */
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1023 closure->fd = locate_file_open_or_access_file (fn, closure->mode);
428
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)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1029 *closure->storeptr = build_intstring (fn);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 /* Keep mapping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037
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 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 not have been expanded. */
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 Lisp_Object suffixes, Lisp_Object *storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 int mode)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 struct locate_file_in_directory_mapper_closure closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 Lisp_Object filename = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 GCPRO3 (directory, str, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 filename = Fexpand_file_name (str, directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 /* If there are non-absolute elts in PATH (eg ".") */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 /* Of course, this could conceivably lose if luser sets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 default-directory to be something non-absolute ... */
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 if (NILP (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 /* NIL means current directory */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 filename = current_buffer->directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 filename = Fexpand_file_name (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 if (NILP (Ffile_name_absolute_p (filename)))
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 /* Give up on this directory! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 closure.fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 closure.storeptr = storeptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 closure.mode = mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1078 locate_file_map_suffixes (filename, suffixes,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1079 locate_file_in_directory_mapper,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 &closure);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 return closure.fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 /* 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
1087
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 Lisp_Object suffixes, Lisp_Object *storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 int mode)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 int absolute = !NILP (Ffile_name_absolute_p (str));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 EXTERNAL_LIST_LOOP (path, path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 if (absolute)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 break;
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 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1109 locate_file_construct_suffixed_files_mapper (Ibyte *fn, void *arg)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1111 Lisp_Object *tail = (Lisp_Object *) arg;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1112 *tail = Fcons (build_intstring (fn), *tail);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 return 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 /* Construct a list of all files to search for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 It makes sense to have this despite locate_file_map_suffixes()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 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
1119 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
1120 path component. See locate_file(). */
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 locate_file_construct_suffixed_files (Lisp_Object filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 Lisp_Object suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 Lisp_Object tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 GCPRO1 (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 locate_file_map_suffixes (filename, suffixes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 locate_file_construct_suffixed_files_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 &tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 return Fnreverse (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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 Clear the hash records for the specified list of directories.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 `locate-file' uses a hashing scheme to speed lookup, and will correctly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 track the following environmental changes:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 -- changes of any sort to the list of directories to be searched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 -- addition and deletion of non-shadowing files (see below) from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 directories in the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 -- byte-compilation of a .el file into a .elc file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 `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
1149 \(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
1150 In this case, you must call `locate-file-clear-hashing'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 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
1153 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
1154 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 (path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 if (EQ (path, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 Fclrhash (Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 Lisp_Object pathtail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 EXTERNAL_LIST_LOOP (pathtail, 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 Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 Fremhash (pathel, Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 /* Search for a file whose name is STR, looking in directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 in the Lisp list PATH, and trying suffixes from SUFFIXES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 SUFFIXES is a list of possible suffixes, or (for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 compatibility) a string containing possible suffixes separated by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 colons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 On success, returns a file descriptor. On failure, returns -1.
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 MODE nonnegative means don't open the files,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 just look for one for which access(file,MODE) succeeds. In this case,
951
93e076dd7825 [xemacs-hg @ 2002-08-02 15:35:49 by james]
james
parents: 867
diff changeset
1180 returns a nonnegative value on success. On failure, returns -1.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 If STOREPTR is nonzero, it points to a slot where the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 the file actually found should be stored as a Lisp string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 Nil is stored there on failure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 Called openp() in FSFmacs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 Lisp_Object *storeptr, int mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 Lisp_Object suffixtab = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 Lisp_Object pathtail, pathel_expanded;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 int val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 if (storeptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 *storeptr = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 /* 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
1202 unless some caller has fucked up. There are known instances that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 call us with build_string("foo:bar") as SUFFIXES, though. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 GCPRO4 (path, str, suffixes, suffixtab);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 /* if this filename has directory components, it's too complicated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 to try and use the hash tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 if (!NILP (Ffile_name_directory (str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
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 EXTERNAL_LIST_LOOP (pathtail, path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 Lisp_Object pathel = XCAR (pathtail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 int found = 0;
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 /* 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
1225 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 if (val >= 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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 return val;
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 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 pathel_expanded = Fexpand_file_name (pathel, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 if (!NILP (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 /* Loop over suffixes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 LIST_LOOP (tail, suffixtab)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 found = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 break;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 if (found)
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 /* This is a likely candidate. Look by hand in this directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 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
1255 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 /* Hmm ... the file isn't actually there. (Or possibly it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 a directory ...) So refresh our hashing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 locate_file_refresh_hashing (pathel_expanded);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 }
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 /* 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
1270 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 /* Sneaky user added a file without telling us. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 Flocate_file_clear_hashing (path);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 return val;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 #ifdef LOADHIST
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 /* 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
1285 into the load_history variable. The details depend on whether
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 the source has an associated file name or not. */
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 build_load_history (int loading, Lisp_Object source)
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 REGISTER Lisp_Object tail, prev, newelt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 REGISTER Lisp_Object tem, tem2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 int foundit;
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 #if !defined(LOADHIST_DUMPED)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 /* Don't bother recording anything for preloaded files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 if (purify_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 tail = Vload_history;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 foundit = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 tem = Fcar (tail);
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 /* Find the feature's previous assoc list... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 if (internal_equal (source, Fcar (tem), 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 foundit = 1;
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 /* If we're loading, remove it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 if (loading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 Vload_history = Fcdr (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 Fsetcdr (prev, Fcdr (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 /* Otherwise, cons on new symbols that are not already members. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 tem2 = Vcurrent_load_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 while (CONSP (tem2))
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 newelt = XCAR (tem2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 if (NILP (Fmemq (newelt, tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 Fsetcar (tail, Fcons (Fcar (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 Fcons (newelt, Fcdr (tem))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 tem2 = XCDR (tem2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 QUIT;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 tail = Fcdr (tail);
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 /* 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
1347 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
1348 an existing member for the current source. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 if (loading || !foundit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 Vload_history);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 #else /* !LOADHIST */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 #define build_load_history(x,y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 #endif /* !LOADHIST */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 readevalloop (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 Lisp_Object sourcename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 Lisp_Object (*evalfun) (Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 int printflag)
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 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1366 REGISTER Ichar c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 REGISTER Lisp_Object val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 struct buffer *b = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 b = XBUFFER (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 b = XMARKER (readcharfun)->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 /* Don't do this. It is not necessary, and it needlessly exposes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 READCHARFUN (which can be a stream) to Lisp. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 /*specbind (Qstandard_input, readcharfun);*/
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 specbind (Qcurrent_load_list, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 GCPRO2 (val, sourcename);
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 LOADHIST_ATTACH (sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 if (b != 0 && !BUFFER_LIVE_P (b))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1395 invalid_operation ("Reading from killed buffer", Qunbound);
428
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 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 if (c == ';')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 /* Skip comment */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 while ((c = readchar (readcharfun)) != '\n' && c != -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 break;
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 /* Ignore whitespace here, so we can detect eof. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1412 unreadchar (readcharfun, c);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1413 Vread_objects = Qnil;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1414 if (NILP (Vload_read_function))
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1415 val = read0 (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 else
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1417 val = call1 (Vload_read_function, readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 val = (*evalfun) (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 if (printflag)
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 Vvalues = Fcons (val, Vvalues);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 if (EQ (Vstandard_output, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 Fprin1 (val, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 Fprint (val, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 build_load_history (LSTREAMP (readcharfun) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 /* This looks weird, but it's what's in FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1435 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 Execute BUFFER as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 Programs can pass two arguments, BUFFER and PRINTFLAG.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 BUFFER is the buffer to evaluate (nil means use current buffer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 PRINTFLAG controls printing of output:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1443 nil means discard it; anything else is a stream for printing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 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
1446 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
1447 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1448 (buffer, printflag))
428
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 Lisp_Object tem, buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1454 if (NILP (buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 buf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1457 buf = Fget_buffer (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 if (NILP (buf))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1459 invalid_argument ("No such buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 if (NILP (printflag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 tem = printflag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 specbind (Qstandard_output, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 record_unwind_protect (save_excursion_restore, save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 readevalloop (buf, XBUFFER (buf)->filename, Feval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 !NILP (printflag));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1471 return unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 }
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 0
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1475 DEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 Execute the current buffer as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 Programs can pass argument PRINTFLAG which controls printing of output:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 nil means discard it; anything else is stream for print.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 If 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
1481 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
1482 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 (printflag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 code omitted;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 Execute the region as Lisp code.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1491 When called from programs, expects two arguments START and END
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 giving starting and ending indices in the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 of the text to be executed.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1494 Programs can pass third optional argument STREAM which controls output:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 nil means discard it; anything else is stream for printing it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 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
1498 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
1499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 Note: Before evaling the region, this function narrows the buffer to it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 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
1502 see some text temporarily disappear because of this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1504 (start, end, stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 Lisp_Object cbuf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1511 if (NILP (stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1514 tem = stream;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 specbind (Qstandard_output, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1517 if (NILP (stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 record_unwind_protect (save_excursion_restore, save_excursion_save ());
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 831
diff changeset
1519 record_unwind_protect (save_restriction_restore,
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 831
diff changeset
1520 save_restriction_save (current_buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1522 /* This both uses start and checks its type. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1523 Fgoto_char (start, cbuf);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1524 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1526 !NILP (stream));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1528 return unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 DEFUN ("read", Fread, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 Read one Lisp expression as text from STREAM, return as Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 If STREAM is nil, use the value of `standard-input' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 STREAM or the value of `standard-input' may be:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 a buffer (read from point and advance it)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 a marker (read from where it points and advance it)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 a function (call it with no arguments for each character,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 call it with a char as argument to push a char back)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 a string (takes text from string, starting at the beginning)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 t (read text line using minibuffer and use it).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 if (NILP (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 stream = Vstandard_input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 if (EQ (stream, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 stream = Qread_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 if (EQ (stream, Qread_char))
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 Lisp_Object val = call1 (Qread_from_minibuffer,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1557 build_msg_string ("Lisp expression: "));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 return Fcar (Fread_from_string (val, Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 if (STRINGP (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 return Fcar (Fread_from_string (stream, Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 return read0 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 Read one Lisp expression which is represented as text by STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 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
1571 they default to 0 and (length STRING) respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 (string, start, end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 Bytecount startval, endval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 Lisp_Object lispstream = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 GCPRO1 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 get_string_range_byte (string, start, end, &startval, &endval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 GB_HISTORICAL_STRING_BEHAVIOR);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 lispstream = make_lisp_string_input_stream (string, startval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 endval - startval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 Vread_objects = 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 tem = read0 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 /* Yeah, it's ugly. Gonna make something of it?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 At least our reader is reentrant ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 tem =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 (Fcons (tem, make_int
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
1597 (string_index_byte_to_char
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1598 (string,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 Lstream_delete (XLSTREAM (lispstream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 /* Use this for recursive reads, in contexts where internal tokens
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 are not allowed. See also read1(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 read0 (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 Lisp_Object val = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 if (CONSP (val) && UNBOUNDP (XCAR (val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1616 Ichar c = XCHAR (XCDR (val));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1617 free_cons (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 list1 (Fchar_to_string (make_char (c))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1625 static Ichar
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 read_escape (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1629 Ichar c = readchar (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1632 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
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 switch (c)
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 case 'a': return '\007';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 case 'b': return '\b';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 case 'd': return 0177;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 case 'e': return 033;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 case 'f': return '\f';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 case 'n': return '\n';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 case 'r': return '\r';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 case 't': return '\t';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 case 'v': return '\v';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 case '\n': return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 case 'M':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1650 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 if (c != '-')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1652 syntax_error ("Invalid escape character syntax", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1655 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 return c | 0200;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 /* Originally, FSF_KEYS provided a degree of FSF Emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 compatibility by defining character "modifiers" alt, super,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 hyper and shift to infest the characters (i.e. integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 However, this doesn't cut it for XEmacs 20, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 distinguishes characters from integers. Without Mule, ?\H-a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 simply returns ?a because every character is clipped into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 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
1668 produces an illegal character, and moves us to crash-land.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 For these reasons, FSF_KEYS hack is useless and without hope
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 of ever working under XEmacs 20. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 #ifdef FSF_KEYS
831
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1673 /* Deleted */
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1674 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 case 'C':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1679 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 if (c != '-')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1681 syntax_error ("Invalid escape character syntax", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 case '^':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1685 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 /* FSFmacs junk for non-ASCII controls.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 Not used here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 if (c == '?')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 return 0177;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 return c & (0200 | 037);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 case '0':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 case '1':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 case '2':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 case '3':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 case '4':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 case '5':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 case '6':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 case '7':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 /* An octal escape, as in ANSI C. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1705 REGISTER Ichar i = c - '0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 REGISTER int count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 while (++count < 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 i = (i << 3) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 }
831
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1717 if (i >= 0400)
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1718 syntax_error ("Attempt to create non-ASCII/ISO-8859-1 character",
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1719 make_int (i));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 return i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 }
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 case 'x':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 /* 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
1725 characters to be read this way. What is "\x4e03" supposed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 mean, anyways, if the internal representation is hidden?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 This is also consistent with the treatment of octal escapes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1729 REGISTER Ichar i = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 REGISTER int count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 while (++count <= 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 c = readchar (readcharfun);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1734 /* Remember, can't use isdigit(), isalpha() etc. on Ichars */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 return i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 }
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 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 /* #### need some way of reading an extended character with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 an escape sequence. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 static Bytecount
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1761 read_atom_0 (Lisp_Object readcharfun, Ichar firstchar, int *saw_a_backslash)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1764 Ichar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 *saw_a_backslash = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 while (c > 040 /* #### - comma should be here as should backquote */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 && !(c == '\"' || c == '\'' || c == ';'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 || c == '(' || c == ')'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 || c == '[' || c == ']' || c == '#'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1779 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 *saw_a_backslash = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 }
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1782 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 c = readchar (readcharfun);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 if (c >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 /* blasted terminating 0 */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1790 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 Lstream_flush (XLSTREAM (Vread_buffer_stream));
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 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1796 static Lisp_Object parse_integer (const Ibyte *buf, Bytecount len, int base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 read_atom (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1800 Ichar firstchar,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 int uninterned_symbol)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 int saw_a_backslash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 char *read_ptr = (char *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 /* Is it an integer? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 if (! (saw_a_backslash || uninterned_symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 /* If a token had any backslashes in it, it is disqualified from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 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
1814 symbol, as is \123 (which is the way (intern "123") prints).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 Also, if token was preceded by #:, it's always a symbol.
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 char *p = read_ptr + len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 char *p1 = read_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 if (*p1 == '+' || *p1 == '-') p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 if (p1 != p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 int 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 while (p1 != p && (c = *p1) >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 /* Integers can have trailing decimal points. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 if (p1 > read_ptr && p1 < p && *p1 == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 if (p1 == p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 /* It is an integer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 if (p1[-1] == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 p1[-1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 #if 0
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 int number = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 if (sizeof (int) == sizeof (EMACS_INT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 number = atoi (read_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 else if (sizeof (long) == sizeof (EMACS_INT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 number = atol (read_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 return make_int (number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 #else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1847 return parse_integer ((Ibyte *) read_ptr, len, 10);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 #endif
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 if (isfloat_string (read_ptr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 return make_float (atof (read_ptr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 Lisp_Object sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 if (uninterned_symbol)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1858 sym = Fmake_symbol ( make_string ((Ibyte *) read_ptr, len));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1861 Lisp_Object name = make_string ((Ibyte *) read_ptr, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 sym = Fintern (name, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 return sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 static Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1870 parse_integer (const Ibyte *buf, Bytecount len, int base)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1872 const Ibyte *lim = buf + len;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1873 const Ibyte *p = buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 EMACS_UINT num = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 int negativland = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 if (*p == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 negativland = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 else if (*p == '+')
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 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 if (p == lim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 goto loser;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 for (; (p < lim) && (*p != '\0'); p++)
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 int c = *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 EMACS_UINT onum;
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 (isdigit (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 c = c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 else if (isupper (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 c = c - 'A' + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 else if (islower (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 c = c - 'a' + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 goto loser;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 if (c < 0 || c >= base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 goto loser;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 onum = num;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 num = num * base + c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 if (num < onum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 Lisp_Object result = make_int (int_result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 if (num && ((XINT (result) < 0) != negativland))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 if (XINT (result) != int_result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 overflow:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1924 list3 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 ("Integer constant overflow in reader"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 make_string (buf, len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 make_int (base)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 loser:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1930 list3 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 ("Invalid integer constant in reader"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 make_string (buf, len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 make_int (base)));
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 read_integer (Lisp_Object readcharfun, int base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 int saw_a_backslash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 return (parse_integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 ((saw_a_backslash)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 ? 0 /* make parse_integer signal error */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 : len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 base));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 read_bit_vector (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1955 Lisp_Object val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1959 unsigned char bit;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1960 Ichar c = readchar (readcharfun);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1961 if (c == '0')
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1962 bit = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1963 else if (c == '1')
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1964 bit = 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1965 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1966 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1967 if (c >= 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1968 unreadchar (readcharfun, c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1969 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1970 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1971 Dynarr_add (dyn, bit);
428
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
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1974 val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1975 Dynarr_length (dyn));
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1976 Dynarr_free (dyn);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1977
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1978 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 /* structures */
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 struct structure_type *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 define_structure_type (Lisp_Object type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 int (*validate) (Lisp_Object data,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
1988 Error_Behavior errb),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 Lisp_Object (*instantiate) (Lisp_Object data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 struct structure_type st;
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 st.type = type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 st.keywords = Dynarr_new (structure_keyword_entry);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 st.validate = validate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 st.instantiate = instantiate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 Dynarr_add (the_structure_type_dynarr, st);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 return Dynarr_atp (the_structure_type_dynarr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 Dynarr_length (the_structure_type_dynarr) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 int (*validate) (Lisp_Object keyword,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 Lisp_Object value,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
2007 Error_Behavior errb))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 struct structure_keyword_entry en;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 en.keyword = keyword;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 en.validate = validate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 Dynarr_add (st->keywords, en);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 static struct structure_type *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 recognized_structure_type (Lisp_Object type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 int i;
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 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 if (EQ (st->type, type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 return st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 read_structure (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2034 Ichar c = readchar (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 Lisp_Object orig_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 Lisp_Object already_seen = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 int keyword_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 struct structure_type *st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 GCPRO2 (orig_list, already_seen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 if (c != '(')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2044 RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 list = read_list (readcharfun, ')', 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 orig_list = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 int len = XINT (Flength (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 if (len == 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2050 RETURN_UNGCPRO (continuable_read_syntax_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 ("structure type not specified"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 if (!(len & 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 RETURN_UNGCPRO
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2054 (continuable_read_syntax_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 ("structures must have alternating keyword/value pairs"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 st = recognized_structure_type (XCAR (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 if (!st)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2061 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 ("unrecognized structure type"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 XCAR (list))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 keyword_count = Dynarr_length (st->keywords);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 while (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 Lisp_Object keyword, value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 struct structure_keyword_entry *en = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 keyword = Fcar (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 value = Fcar (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 if (!NILP (memq_no_quit (keyword, already_seen)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2080 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 ("structure keyword already seen"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 keyword)));
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 for (i = 0; i < keyword_count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 en = Dynarr_atp (st->keywords, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 if (EQ (keyword, en->keyword))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 if (i == keyword_count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2093 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 ("unrecognized structure keyword"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 keyword)));
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 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 RETURN_UNGCPRO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2100 list3 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 ("invalid value for structure keyword"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 keyword, value)));
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 already_seen = Fcons (keyword, already_seen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2109 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 ("invalid structure initializer"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 orig_list)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 int terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 /* Get the next character; filter out whitespace and comments */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2123 static Ichar
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 reader_nextchar (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2127 Ichar c;
428
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 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2133 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 default:
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 /* Ignore whitespace and control characters */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 if (c <= 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 case ';':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 /* Comment */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
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 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 /* Read the next Lisp object from the stream READCHARFUN and return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 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
2165 encountered a misplaced token (e.g. a right bracket, right paren,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 or dot followed by a non-number). To filter this stuff out,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 use read0(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 read1 (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2172 Ichar c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 c = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 case '(':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 /* if this is disabled, then other code in eval.c must be enabled */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2183 Ichar ch = reader_nextchar (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 switch (ch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 case '`':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 Lisp_Object tem;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2189 int speccount = internal_bind_int (&old_backquote_flag,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2190 1 + old_backquote_flag);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 tem = read0 (readcharfun);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2192 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 if (ch != ')')
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 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2198 list1 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 ("Weird old-backquote syntax")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 return list2 (Qbacktick, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 case ',':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 if (old_backquote_flag)
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 Lisp_Object tem, comma_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 ch = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 if (ch == '@')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 comma_type = Qcomma_at;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 if (ch >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 comma_type = Qcomma;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 tem = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 if (ch != ')')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2223 list1 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 ("Weird old-backquote syntax")));
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 return list2 (comma_type, tem);
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2233 list1 (build_msg_string ("Comma outside of backquote")));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 /* #### - yuck....but this is reverse compatible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 /* mostly this is required by edebug, which does its own
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 annotated reading. We need to have an annotated_read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 function that records (with markers) the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 positions of the elements that make up lists, then that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 can be used in edebug and bytecomp and the check above
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 can go back in. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 } /* switch(ch) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 #endif /* old backquote crap... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 return read_list (readcharfun, ')', 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 case '[':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 return read_vector (readcharfun, ']');
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 case ')':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 case ']':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 /* #### - huh? these don't do what they seem... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 return noseeum_cons (Qunbound, make_char (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 case '.':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 /* 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
2262 as a floating point number. Otherwise, it denotes a dotted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 pair.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2268 /* Can't use isdigit on Ichars */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 if (c < '0' || c > '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 return noseeum_cons (Qunbound, make_char ('.'));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 /* Note that read_atom will loop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 at least once, assuring that we will not try to UNREAD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 two characters in a row.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 (I think this doesn't matter anymore because there should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 be no more danger in unreading multiple characters) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 return read_atom (readcharfun, '.', 0);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 case '#':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 #if 0 /* FSFmacs silly char-table syntax */
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 #if 0 /* FSFmacs silly bool-vector syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 case '&':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 /* "#["-- byte-code constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 /* purecons #[...] syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 case '[': return read_compiled_function (readcharfun, ']'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 /*, purify_flag */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 /* "#:"-- gensym syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 case ':': return read_atom (readcharfun, -1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 /* #'x => (function x) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 case '\'': return list2 (Qfunction, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 /* RMS uses this syntax for fat-strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 If we use it for vectors, then obscure bugs happen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 /* "#(" -- Scheme/CL vector syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 case '(': return read_vector (readcharfun, ')');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 case '(':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 Lisp_Object tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 /* Read the string itself. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 tmp = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 if (!STRINGP (tmp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2317 free_cons (tmp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 GCPRO1 (tmp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 /* Read the intervals and their properties. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 Lisp_Object beg, end, plist;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2326 Ichar ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 int invalid = 0;
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 beg = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 ch = XCHAR (XCDR (beg));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2333 free_cons (beg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 if (ch == ')')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 if (!invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 end = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 if (CONSP (end) && UNBOUNDP (XCAR (end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2344 free_cons (end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 if (!invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 plist = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2353 free_cons (plist);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 invalid = 1;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 if (invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 RETURN_UNGCPRO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 list2
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2361 (build_msg_string ("invalid string property list"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 XCDR (plist))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 Fset_text_properties (beg, end, plist, tmp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 return tmp;
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 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 case '@':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 /* #@NUMBER is used to skip NUMBER following characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 That's used in .elc files to skip over doc strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 and function definitions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 int i, nskip = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 /* Read a decimal integer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 while ((c = readchar (readcharfun)) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 && c >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 nskip = (10 * nskip) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 if (c >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 /* FSF has code here that maybe caches the skipped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 string. See above for why this is totally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 losing. We handle this differently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 /* Skip that many characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 for (i = 0; i < nskip && c >= 0; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 c = readchar (readcharfun);
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 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 case '$': return Vload_file_name_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 /* bit vectors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 case '*': return read_bit_vector (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 /* #o10 => 8 -- octal constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 case 'o': return read_integer (readcharfun, 8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 /* #xdead => 57005 -- hex constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 case 'x': return read_integer (readcharfun, 16);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 /* #b010 => 2 -- binary constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 case 'b': return read_integer (readcharfun, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 case 's': return read_structure (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 case '<':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2408 list1 (build_msg_string ("Cannot read unreadable object")));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 case '+':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 case '-':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 {
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2414 Lisp_Object feature_exp, obj, tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2417 feature_exp = read0(readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 obj = read0(readcharfun);
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 /* the call to `featurep' may GC. */
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2421 GCPRO2 (feature_exp, obj);
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2422 tem = call1 (Qfeaturep, feature_exp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 if (c == '+' && NILP(tem)) goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 if (c == '-' && !NILP(tem)) goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 return obj;
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 case '0': case '1': case '2': case '3': case '4':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 case '5': case '6': case '7': case '8': case '9':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 /* Reader forms that can reuse previously read objects. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 int n = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 Lisp_Object found;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 /* Using read_integer() here is impossible, because it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 chokes on `='. Using parse_integer() is too hard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 So we simply read it in, and ignore overflows, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 is safe. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 while (c >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 n *= 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 n += c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 found = assq_no_quit (make_int (n), Vread_objects);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 if (c == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 /* #n=object returns object, but associates it with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 n for #n#. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 Lisp_Object obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 if (CONSP (found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2455 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 ("Multiply defined symbol label"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 make_int (n)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 obj = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 Vread_objects = Fcons (Fcons (make_int (n), obj),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 Vread_objects);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 else if (c == '#')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 /* #n# returns a previously read object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 if (CONSP (found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 return XCDR (found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2470 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 ("Undefined symbol label"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 make_int (n)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 default:
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 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 /* Quote */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 case '\'': return list2 (Qquote, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 case '`':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 Lisp_Object tem;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2493 int speccount = internal_bind_int (&new_backquote_flag,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2494 1 + new_backquote_flag);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 tem = read0 (readcharfun);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2496 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 return list2 (Qbackquote, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 if (new_backquote_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 Lisp_Object comma_type = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 int ch = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 if (ch == '@')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 comma_type = Qcomma_at;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 else if (ch == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 comma_type = Qcomma_dot;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 else
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 (ch >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 comma_type = Qcomma;
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 return list2 (comma_type, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 /* YUCK. 99.999% backwards compatibility. The Right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 Thing(tm) is to signal an error here, because it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 really invalid read syntax. Instead, this permits
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 commas to begin symbols (unless they're inside
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 backquotes). If an error is signalled here in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 future, then commas should be invalid read syntax
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 outside of backquotes anywhere they're found (i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 they must be quoted in symbols) -- Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 return read_atom (readcharfun, c, 0);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 case '?':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 /* Evil GNU Emacs "character" (ie integer) syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 return make_char (c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 case '\"':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 /* String */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 /* #### If the input stream is translating, then the string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 should be marked as translatable by setting its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 `string-translatable' property to t. .el and .elc files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 normally are translating input streams. See Fgettext()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 and print_internal(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 int cancel = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 while ((c = readchar (readcharfun)) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 && c != '\"')
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 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 /* c is -1 if \ newline has just been seen */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 if (c == -1)
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 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 cancel = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2571 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 QUIT;
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 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (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 /* If purifying, and string starts with \ newline,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 return zero instead. This is for doc strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 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
2580 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 Lstream_flush (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 make_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
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 default:
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 /* Ignore whitespace and control characters */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 if (c <= 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 return read_atom (readcharfun, c, 0);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 #define LEAD_INT 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 #define DOT_CHAR 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 #define TRAIL_INT 4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 #define E_CHAR 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 #define EXP_INT 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2609 isfloat_string (const char *cp)
428
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 int state = 0;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2612 const Ibyte *ucp = (const Ibyte *) cp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 if (*ucp == '+' || *ucp == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 if (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 state |= LEAD_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 if (*ucp == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 state |= DOT_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 if (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 state |= TRAIL_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 if (*ucp == 'e' || *ucp == 'E')
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 state |= E_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 if ((*ucp == '+') || (*ucp == '-'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 if (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 state |= EXP_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 ucp++;
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 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 || (*ucp == '\r') || (*ucp == '\f'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 || state == (DOT_CHAR|TRAIL_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 || state == (LEAD_INT|E_CHAR|EXP_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 static void *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 sequence_reader (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2659 Ichar terminator,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 void *state,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 void * (*conser) (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 void *state, Charcount len))
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 Charcount len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 for (len = 0; ; len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2668 Ichar ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 ch = reader_nextchar (readcharfun);
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 if (ch == terminator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 return state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 if (ch == ']')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2679 read_syntax_error ("\"]\" in a list");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 else if (ch == ')')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2681 read_syntax_error ("\")\" in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 state = ((conser) (readcharfun, state, len));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 }
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 struct read_list_state
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 Lisp_Object head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 int length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 int allow_dotted_lists;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2694 Ichar terminator;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 static void *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
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 struct read_list_state *s = (struct read_list_state *) state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 Lisp_Object elt;
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 elt = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 Lisp_Object tem = elt;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2708 Ichar ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 elt = XCDR (elt);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2711 free_cons (tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 ch = XCHAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 if (ch == s->terminator) /* deal with #+, #- reader macros */
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 unreadchar (readcharfun, s->terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 goto done;
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 else if (ch == ']')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2721 read_syntax_error ("']' in a list");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 else if (ch == ')')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2723 read_syntax_error ("')' in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 if (ch != '.')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2727 signal_error (Qinternal_error, "BUG! Internal reader error", elt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 else if (!s->allow_dotted_lists)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2729 read_syntax_error ("\".\" in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 if (!NILP (s->tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 XCDR (s->tail) = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 s->head = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 elt = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 ch = XCHAR (XCDR (elt));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2740 free_cons (elt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 if (ch == s->terminator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 unreadchar (readcharfun, s->terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2747 read_syntax_error (". in wrong context");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 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
2753 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 Vcurrent_compiled_function_annotation = elt;
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 #endif
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 elt = Fcons (elt, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 if (!NILP (s->tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 XCDR (s->tail) = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 s->head = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 s->tail = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 s->length++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 return s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2773 /* allow_dotted_lists means that something like (foo bar . baz)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2774 is acceptable. If -1, means check for starting with defun
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2775 and make structure pure. (not implemented, probably for very
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2776 good reasons)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2777
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2778 If check_for_doc_references, look for (#$ . INT) doc references
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2779 in the list and record if load_force_doc_strings is non-zero.
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2780 (Such doc references will be destroyed during the loadup phase
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2781 by replacing with Qzero, because Snarf-documentation will fill
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2782 them in again.)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2783
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2784 WARNING: If you set this, you sure as hell better not call
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2785 free_list() on the returned list here.
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2786 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 read_list (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2790 Ichar terminator,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 int allow_dotted_lists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 int check_for_doc_references)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 struct read_list_state s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 Lisp_Object old_compiled_function_annotation =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 Vcurrent_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 s.head = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 s.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 s.length = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 s.allow_dotted_lists = allow_dotted_lists;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 s.terminator = terminator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 GCPRO2 (s.head, s.tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 #endif
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 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 /* check now for any doc string references and record them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 for later. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 /* We might be dealing with an imperfect list so don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 use LIST_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 Lisp_Object holding_cons = Qnil;
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 Lisp_Object elem = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 /* elem might be (#$ . INT) ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 holding_cons = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 /* or it might be (quote (#$ . INT)) i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 (quote . ((#$ . INT) . nil)) in the case of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 `autoload' (autoload evaluates its arguments, while
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 `defvar', `defun', etc. don't). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 && CONSP (XCDR (elem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 elem = XCAR (XCDR (elem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 holding_cons = XCDR (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 if (CONSP (holding_cons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 if (purify_flag)
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 if (NILP (Vinternal_doc_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 /* We have not yet called Snarf-documentation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 assume this file is described in the DOC file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 and Snarf-documentation will fill in the right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 value later. For now, replace the whole list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 with 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 XCAR (holding_cons) = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 /* We have already called Snarf-documentation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 make a relative file name for this file, so it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 can be found properly in the installed Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 directory. We don't use Fexpand_file_name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 because that would make the directory absolute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 XCAR (XCAR (holding_cons)) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 concat2 (build_string ("../lisp/"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 Ffile_name_nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 (Vload_file_name_internal));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 /* Not pure. Just add to Vload_force_doc_string_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 and the string will be filled in properly in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 load_force_doc_string_unwind(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 Vload_force_doc_string_list =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 /* We pass the cons that holds the (#$ . INT) so we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 can modify it in-place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 Fcons (holding_cons, Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 return s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 read_vector (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2884 Ichar terminator)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 Lisp_Object *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 struct read_list_state s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 s.head = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 s.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 s.length = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 s.allow_dotted_lists = 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 tem = s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 len = XINT (Flength (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
2905 s.head = make_vector (len, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 i < len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 i++, p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2911 Lisp_Object otem = tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 tem = Fcar (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 *p = tem;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2914 tem = XCDR (otem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 free_cons (otem);
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 return s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 static Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2921 read_compiled_function (Lisp_Object readcharfun, Ichar terminator)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 /* Accept compiled functions at read-time so that we don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 have to build them at load-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 Lisp_Object stuff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 int iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 int saw_a_doc_ref = 0;
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 /* Note: we tell read_list not to search for doc references
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 because we need to handle the "doc reference" for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 instructions and constants differently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 stuff = read_list (readcharfun, terminator, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 len = XINT (Flength (stuff));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 return
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2939 continuable_read_syntax_error ("#[...] used with wrong number of elements");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 for (iii = 0; CONSP (stuff); iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2943 Lisp_Object victim = stuff;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 make_byte_code_args[iii] = Fcar (stuff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 if ((purify_flag || load_force_doc_strings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 && CONSP (make_byte_code_args[iii])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 if (purify_flag && iii == COMPILED_DOC_STRING)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 /* same as in read_list(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 if (NILP (Vinternal_doc_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 make_byte_code_args[iii] = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 XCAR (make_byte_code_args[iii]) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 concat2 (build_string ("../lisp/"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 Ffile_name_nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 (Vload_file_name_internal));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 saw_a_doc_ref = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 stuff = Fcdr (stuff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 free_cons (victim);
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 GCPRO1 (make_byte_code_args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 gcpro1.nvars = len;
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 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 ebolify_bytecode_constants (make_byte_code_args[2]);
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 /* make-byte-code looks at purify_flag, which should have the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 * value as our "read-pure" argument */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 stuff = Fmake_byte_code (len, make_byte_code_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 if (saw_a_doc_ref)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 return stuff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 init_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 Vvalues = Qnil;
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 load_in_progress = 0;
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 Vload_descriptor_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 /* 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
2995 the file name is absolute. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 Vload_path = Fcons (build_string (""), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 /* This used to get initialized in init_lread because all streams
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 got closed when dumping occurs. This is no longer true --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 Vread_buffer_stream is a resizing output stream, and there is no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 reason to close it at dump-time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 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
3005 will initialize it only once, at dump-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 if (NILP (Vread_buffer_stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 Vload_force_doc_string_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 syms_of_lread (void)
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 DEFSUBR (Fread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 DEFSUBR (Fread_from_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 DEFSUBR (Fload_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 DEFSUBR (Flocate_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 DEFSUBR (Flocate_file_clear_hashing);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 DEFSUBR (Feval_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 DEFSUBR (Feval_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3023 DEFSYMBOL (Qstandard_input);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3024 DEFSYMBOL (Qread_char);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3025 DEFSYMBOL (Qcurrent_load_list);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3026 DEFSYMBOL (Qload);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3027 DEFSYMBOL (Qload_file_name);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
3028 DEFSYMBOL (Qload_internal);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3029 DEFSYMBOL (Qfset);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 #ifdef LISP_BACKQUOTES
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3032 DEFSYMBOL (Qbackquote);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 defsymbol (&Qbacktick, "`");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 defsymbol (&Qcomma, ",");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 defsymbol (&Qcomma_at, ",@");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 defsymbol (&Qcomma_dot, ",.");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3039 DEFSYMBOL (Qexists);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3040 DEFSYMBOL (Qreadable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3041 DEFSYMBOL (Qwritable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3042 DEFSYMBOL (Qexecutable);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 structure_type_create (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 the_structure_type_dynarr = Dynarr_new (structure_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 reinit_vars_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 Vread_buffer_stream = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 staticpro_nodump (&Vread_buffer_stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 vars_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 reinit_vars_of_lread ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 DEFVAR_LISP ("values", &Vvalues /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 List of values of all expressions which were read, evaluated and printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 Order is reverse chronological.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 Stream for read to get input from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 See documentation of `read' for possible values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 Vstandard_input = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 DEFVAR_LISP ("load-path", &Vload_path /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 *List of directories to search for files to load.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 Each element is a string (directory name) or nil (try default directory).
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 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
3079 call `expand-file-name' on them before adding them to this list.
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 Initialized based on EMACSLOADPATH environment variable, if any,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 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
3083 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
3084 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
3085 directory in which the XEmacs executable resides.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 Vload_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 "*Location of lisp files to be used when dumping ONLY."); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 Non-nil iff inside of `load'.
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 An alist of expressions to be evalled when particular files are loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 Each element looks like (FILENAME FORMS...).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 When `load' is run and the file-name argument is FILENAME,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 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
3101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 FILENAME must match exactly! Normally FILENAME is the name of a library,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 with no directory specified, since that is how `load' is normally called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 An error in FORMS does not undo the load,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 but does prevent execution of the rest of the FORMS.
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 Vafter_load_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 *Whether `load' should check whether the source is newer than the binary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 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
3112 corresponding `.el' is newer, a warning message will be printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 */ );
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
3114 load_warn_when_source_newer = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 *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
3118 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
3119 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
3120 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
3121 no warning will be printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 load_warn_when_source_only = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 *Whether `load' should ignore `.elc' files when a suffix is not given.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 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
3128 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 load_ignore_elc_files = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3131 DEFVAR_BOOL ("load-ignore-out-of-date-elc-files",
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3132 &load_ignore_out_of_date_elc_files /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3133 *Whether `load' should ignore out-of-date `.elc' files when no suffix is given.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3134 This is normally used when compiling packages of elisp files that may have
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3135 complex dependencies. Ignoring all elc files with `load-ignore-elc-files'
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3136 would also be safe, but much slower.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3137 */ );
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3138 load_ignore_out_of_date_elc_files = 0;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3139
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3140 DEFVAR_BOOL ("load-always-display-messages",
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3141 &load_always_display_messages /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3142 *Whether `load' should always display loading messages.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3143 If this is true, every file loaded will be shown, regardless of the setting
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3144 of the NOMESSAGE parameter, and even when files are loaded indirectly, e.g.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3145 due to `requre'.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3146 */ );
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3147 load_always_display_messages = 0;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3148
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3149 DEFVAR_BOOL ("load-show-full-path-in-messages",
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3150 &load_show_full_path_in_messages /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3151 *Whether `load' should show the full path in all loading messages.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3152 */ );
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3153 load_show_full_path_in_messages = 0;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3154
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 #ifdef LOADHIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 DEFVAR_LISP ("load-history", &Vload_history /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 Alist mapping source file names to symbols and features.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 Each alist element is a list that starts with a file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 except for one element (optional) that starts with nil and describes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 definitions evaluated from buffers not visiting files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 The remaining elements of each list are symbols defined as functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 Vload_history = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 Used for internal purposes by `load'.
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 Vcurrent_load_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 Full name of file being loaded by `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 Vload_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 Function used by `load' and `eval-region' for reading expressions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 The default is nil, which means use the function `read'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 Vload_read_function = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 Non-nil means `load' should force-load all dynamic doc strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 This is useful when the file being loaded is a temporary copy.
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 load_force_doc_strings = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 /* See read_escape(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 /* Used to be named `puke-on-fsf-keys' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 &fail_on_bucky_bit_character_escapes /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 Whether `read' should signal an error when it encounters unsupported
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 character escape syntaxes or just read them incorrectly.
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 fail_on_bucky_bit_character_escapes = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 /* This must be initialized in init_lread otherwise it may start out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 with values saved when the image is dumped. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 staticpro (&Vload_descriptor_list);
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 /* Initialized in init_lread. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 staticpro (&Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 Vload_file_name_internal = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 staticpro (&Vload_file_name_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 Vload_file_name_internal_the_purecopy = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 staticpro (&Vload_file_name_internal_the_purecopy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 staticpro (&Vcurrent_compiled_function_annotation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 #endif
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 /* So that early-early stuff will work */
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
3219 Ffset (Qload, Qload_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 #ifdef FEATUREP_SYNTAX
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3222 DEFSYMBOL (Qfeaturep);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
3223 Fprovide (intern ("xemacs"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 #ifdef INFODOCK
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
3225 Fprovide (intern ("infodock"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 #endif /* INFODOCK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 #endif /* FEATUREP_SYNTAX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 old_backquote_flag = new_backquote_flag = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 Vfile_domain = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 #endif
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 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 staticpro (&Vread_objects);
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 Vlocate_file_hash_table = make_lisp_hash_table (200,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 HASH_TABLE_NON_WEAK,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 HASH_TABLE_EQUAL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 staticpro (&Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 = Vlocate_file_hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 }