annotate src/lread.c @ 844:047d37eb70d7

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