annotate src/lread.c @ 4844:91b3d00e717f

Various cleanups for Dynarr code, from Unicode-internal ws dynarr.c: Add comment explaining Dynarr_largest() use. dynarr.c: In Dynarr_insert_many(), don't call Dynarr_resize() unless we actually need to resize, and note that an assert() that we are inserting at or below the current end could be wrong if code wants to access stuff between `len' and `largest'. dynarr.c: Don't just Dynarr_resize() to the right size; instead use Dynarr_reset() then Dynarr_add_many(), so that the 'len' and 'largest' and such get set properly. dynarr.c, faces.c, gutter.c, lisp.h, lread.c, lrecord.h, redisplay-output.c, redisplay.c: Rename Dynarr member 'cur' to 'len' since it's the length of the dynarr, not really a pointer to a "current insertion point". Use type_checking_assert() instead of just assert() in some places. Add additional assertions (Dynarr_verify*()) to check that we're being given positions within range. Use them in Dynarr_at, Dynarr_atp, etc. New Dynarr_atp_allow_end() for retrieving a pointer to a position that might be the element past the last one. New Dynarr_past_lastp() to retrieve a pointer to the position past the last one, using Dynarr_atp_allow_end(). Change code appropriately to use it. Rename Dynarr_end() to Dynarr_lastp() (pointer to the last element) for clarity, and change code appropriately to use it. Change code appropriately to use Dynarr_begin(). Rewrite Dynarr_add_many(). New version can accept a NULL pointer to mean "reserve space but don't put anything in it". Used by stack_like_malloc().
author Ben Wing <ben@xemacs.org>
date Wed, 13 Jan 2010 04:07:42 -0600
parents 8f1ee2d15784
children 17362f371cc2 19a72041c5ed
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Lisp parsing and input streams.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Tinker Systems.
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
4 Copyright (C) 1996, 2001, 2002, 2003 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "elhash.h"
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
33 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "opaque.h"
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
36 #include "profile.h"
3439
d1754e7f0cea [xemacs-hg @ 2006-06-03 17:50:39 by aidan]
aidan
parents: 3367
diff changeset
37 #include "charset.h" /* For Funicode_to_char. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "sysfloat.h"
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
41 #ifdef WIN32_NATIVE
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
42 #include "syswindows.h"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
43 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 Lisp_Object Qread_char, Qstandard_input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Lisp_Object Qvariable_documentation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #define LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Nonzero means inside a new-style backquote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 with no surrounding parentheses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 Fread initializes this to zero, so we need not specbind it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 or worry about what happens to it when there is an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 XEmacs:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Nested backquotes are perfectly legal and fail utterly with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 this silliness. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 static int new_backquote_flag, old_backquote_flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 Lisp_Object Qvariable_domain; /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
63 Lisp_Object Vload_suppress_alist;
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
64 Lisp_Object Qload, Qload_internal, Qfset;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 /* Hash-table that maps directory names to hashes of their contents. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 static Lisp_Object Vlocate_file_hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 /* See read_escape() for an explanation of this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 int fail_on_bucky_bit_character_escapes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 /* This symbol is also used in fns.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 #define FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Lisp_Object Qfeaturep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 /* non-zero if inside `load' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 int load_in_progress;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 /* Whether Fload_internal() should check whether the .el is newer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 when loading .elc */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 int load_warn_when_source_newer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 /* Whether Fload_internal() should check whether the .elc doesn't exist */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 int load_warn_when_source_only;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 int load_ignore_elc_files;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
93 /* Whether Fload_internal() should ignore out-of-date .elc files when no
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
94 suffix is given */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
95 int load_ignore_out_of_date_elc_files;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
96 /* Always display messages showing when a file is loaded, regardless of
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
97 whether the flag to `load' tries to suppress them. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
98 int load_always_display_messages;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
99 /* Show the full path in loading messages. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
100 int load_show_full_path_in_messages;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 /* Search path for files to be loaded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 Lisp_Object Vload_path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 /* Search path for files when dumping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 /* Lisp_Object Vdump_load_path; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 /* This is the user-visible association list that maps features to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 lists of defs in their load files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Lisp_Object Vload_history;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 /* This is used to build the load history. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 Lisp_Object Vcurrent_load_list;
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 /* Name of file actually being read by `load'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 Lisp_Object Vload_file_name;
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 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 our #$ checks are reliable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 Lisp_Object Vload_file_name_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 /* Function to use for reading, in `load' and friends. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Lisp_Object Vload_read_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 /* The association list of objects read with the #n=object form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 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
127 look up the object for the corresponding #n# construct.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 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
129 Lisp_Object Vread_objects;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 /* Nonzero means load should forcibly load all dynamic doc strings. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 /* Note that this always happens (with some special behavior) when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 purify_flag is set. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 static int load_force_doc_strings;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 /* List of descriptors now open for Fload_internal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 static Lisp_Object Vload_descriptor_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 /* In order to implement "load_force_doc_strings", we keep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 a list of all the compiled-function objects and such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 that we have created in the process of loading this file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 See the rant below.
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 We specbind this just like Vload_file_name, so there's no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 problems with recursive loading. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 static Lisp_Object Vload_force_doc_string_list;
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 /* A resizing-buffer stream used to temporarily hold data while reading */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 static Lisp_Object Vread_buffer_stream;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Lisp_Object Vcurrent_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 static int load_byte_code_version;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* An array describing all known built-in structure types */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 static structure_type_dynarr *the_structure_type_dynarr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 #if 0 /* FSF stuff */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 /* For use within read-from-string (this reader is non-reentrant!!) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 static int read_from_string_index;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 static int read_from_string_limit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 #if 0 /* More FSF implementation kludges. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 /* In order to implement load-force-doc-string, FSF saves the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 #@-quoted string when it's seen, and goes back and retrieves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 it later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 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
172 correctly because there's no stack of remembered #@-quoted-strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 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
174 order as their #$ references. (Yes, that is amazingly stupid too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 It would be trivially easy to always encode the #@ string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 [which is a comment, anyway] in the middle of the (#$ . INT) cons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 reference. That way, it would be really easy to implement
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 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
180 string immediately, because it's delivered on a silver platter.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 And finally, this stupid approach doesn't work under Mule, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 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
184 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
185 count.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Oh, and one more lossage in this approach: If you attempt to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 dump any ELC files that were compiled with `byte-compile-dynamic'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (as opposed to just `byte-compile-dynamic-docstring'), you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 get hosed. FMH! (as the illustrious JWZ was prone to utter)
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 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
193 probably easier to implement anyway. We just save a list of all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 the containing objects that have (#$ . INT) conses in them (this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 will only be compiled-function objects and lists), and when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 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
197 doc strings at once. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 /* This contains the last string skipped with #@. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 static char *saved_doc_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 /* Length of buffer allocated in saved_doc_string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 static int saved_doc_string_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 /* Length of actual data in saved_doc_string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 static int saved_doc_string_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 /* This is the file position that string came from. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 static int saved_doc_string_position;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
209 static int locate_file_open_or_access_file (Ibyte *fn, int access_mode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 EXFUN (Fread_from_string, 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 /* When errors are signaled, the actual readcharfun should not be used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 as an argument if it is an lstream, so that lstreams don't escape
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 to the Lisp level. */
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
215 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
216 ? (build_msg_string ("internal input stream")) \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 : (x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
2268
61855263cb07 [xemacs-hg @ 2004-09-14 14:32:29 by james]
james
parents: 2013
diff changeset
220 static DECLARE_DOESNT_RETURN (read_syntax_error (const char *));
61855263cb07 [xemacs-hg @ 2004-09-14 14:32:29 by james]
james
parents: 2013
diff changeset
221
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 static DOESNT_RETURN
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
223 read_syntax_error (const char *string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
225 signal_error (Qinvalid_read_syntax, string, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
229 continuable_read_syntax_error (const char *string)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
231 return signal_continuable_error (Qinvalid_read_syntax, string, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 /* Handle unreading and rereading of characters. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
236 static Ichar
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 readchar (Lisp_Object readcharfun)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
243 Ichar c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 struct buffer *b = XBUFFER (readcharfun);
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 if (!BUFFER_LIVE_P (b))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
247 invalid_operation ("Reading from killed buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 if (BUF_PT (b) >= BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 c = BUF_FETCH_CHAR (b, BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 BUF_SET_PT (b, BUF_PT (b) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 else if (LSTREAMP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
258 Ichar c = Lstream_get_ichar (XLSTREAM (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 #ifdef DEBUG_XEMACS /* testing Mule */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 static int testing_mule = 0; /* Change via debugger */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
261 if (testing_mule)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
262 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
263 if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
264 else if (c == '\n') stderr_out ("\\n\n");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
265 else stderr_out ("\\%o ", c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
266 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
267 #endif /* testing Mule */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
272 Ichar c;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
273 Charbpos mpos = marker_position (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
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 (mpos >= BUF_ZV (inbuffer))
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 c = BUF_FETCH_CHAR (inbuffer, mpos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 set_marker_position (readcharfun, mpos + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 return c;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 Lisp_Object tem = call0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 if (!CHAR_OR_CHAR_INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 return XCHAR_OR_CHAR_INT (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 /* Unread the character C in the way appropriate for the stream READCHARFUN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 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
294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 static void
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
296 unreadchar (Lisp_Object readcharfun, Ichar c)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 if (c == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 /* 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
300 since readchar didn't advance it when we read it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 else if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 else if (LSTREAMP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
306 Lstream_unget_ichar (XLSTREAM (readcharfun), c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 #ifdef DEBUG_XEMACS /* testing Mule */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 static int testing_mule = 0; /* Set this using debugger */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 if (testing_mule)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 fprintf (stderr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 call1 (readcharfun, make_char (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 static Lisp_Object read0 (Lisp_Object readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 static Lisp_Object read1 (Lisp_Object readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 static Lisp_Object read_list (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
326 Ichar terminator,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 int allow_dotted_lists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 int check_for_doc_references);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 static void readevalloop (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 Lisp_Object sourcefile,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 Lisp_Object (*evalfun) (Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 int printflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 Lstream_close (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 return Qnil;
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
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
342 /* Check if NONRELOC/RELOC (an absolute filename) is suppressed according
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
343 to load-suppress-alist. */
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
344 static int
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
345 check_if_suppressed (Ibyte *nonreloc, Lisp_Object reloc)
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
346 {
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
347 Bytecount len;
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
348
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
349 if (!NILP (reloc))
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
350 {
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
351 nonreloc = XSTRING_DATA (reloc);
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
352 len = XSTRING_LENGTH (reloc);
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
353 }
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
354 else
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
355 len = qxestrlen (nonreloc);
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
356
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
357 if (len >= 4 && !qxestrcmp_ascii (nonreloc + len - 4, ".elc"))
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
358 len -= 4;
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
359 else if (len >= 3 && !qxestrcmp_ascii (nonreloc + len - 3, ".el"))
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
360 len -= 3;
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
361
2567
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
362 {
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
363 EXTERNAL_LIST_LOOP_2 (acons, Vload_suppress_alist)
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
364 {
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
365 if (CONSP (acons) && STRINGP (XCAR (acons)))
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
366 {
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
367 Lisp_Object name = XCAR (acons);
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
368 if (XSTRING_LENGTH (name) == len &&
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
369 !memcmp (XSTRING_DATA (name), nonreloc, len))
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
370 {
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
371 struct gcpro gcpro1;
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
372 Lisp_Object val;
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
373
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
374 GCPRO1 (reloc);
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4608
diff changeset
375 val = IGNORE_MULTIPLE_VALUES (Feval (XCDR (acons)));
2567
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
376 UNGCPRO;
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
377
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
378 if (!NILP (val))
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
379 return 1;
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
380 }
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
381 }
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
382 }
bbc3231c4812 [xemacs-hg @ 2005-02-04 11:57:28 by vins]
vins
parents: 2548
diff changeset
383 }
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
384
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
385 return 0;
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
386 }
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
387
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 /* The plague is coming.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 Ring around the rosy, pocket full of posy,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 Ashes ashes, they all fall down.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 ebolify_bytecode_constants (Lisp_Object vector)
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 int len = XVECTOR_LENGTH (vector);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 for (i = 0; i < len; i++)
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 el = XVECTOR_DATA (vector)[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 /* We don't check for `eq', `equal', and the others that have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 bytecode opcodes. This might lose if someone passes #'eq or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 something to `funcall', but who would really do that? As
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 they say in law, we've made a "good-faith effort" to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 unfuckify ourselves. And doing it this way avoids screwing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 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
409 add an extra Ebola check in decode_weak_list_type(). --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (EQ (el, Qassoc)) el = Qold_assoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 else if (EQ (el, Qdelq)) el = Qold_delq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 /* I think this is a bad idea because it will probably mess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 with keymap code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 else if (EQ (el, Qdelete)) el = Qold_delete;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 else if (EQ (el, Qrassq)) el = Qold_rassq;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 XVECTOR_DATA (vector)[i] = el;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 static Lisp_Object
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
425 pas_de_holgazan_ici (int fd, Lisp_Object victim)
428
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 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 EMACS_INT pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 if (!INTP (XCDR (victim)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
431 invalid_byte_code ("Bogus doc string reference", victim);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 pos = XINT (XCDR (victim));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 if (pos < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 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
435 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
436 if (!STRINGP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
437 signal_error_1 (Qinvalid_byte_code, tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 return tem;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 load_force_doc_string_unwind (Lisp_Object oldlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 Lisp_Object list = Vload_force_doc_string_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 int fd = XINT (XCAR (Vload_descriptor_list));
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 GCPRO1 (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 /* restore the old value first just in case an error occurs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 Vload_force_doc_string_list = oldlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 LIST_LOOP (tail, list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 Lisp_Object john = Fcar (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 if (CONSP (john))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 assert (CONSP (XCAR (john)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 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
460 XCAR (john) = pas_de_holgazan_ici (fd, XCAR (john));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 else
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 Lisp_Object doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 assert (COMPILED_FUNCTIONP (john));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 struct gcpro ngcpro1;
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
470 Lisp_Object juan = (pas_de_holgazan_ici
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
471 (fd,
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
472 XCOMPILED_FUNCTION (john)->instructions));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 Lisp_Object ivan;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 NGCPRO1 (juan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 ivan = Fread (juan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 if (!CONSP (ivan))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
478 invalid_byte_code ("invalid lazy-loaded byte code", ivan);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 if (XCOMPILED_FUNCTION (john)->flags.ebolified
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 && VECTORP (XCDR (ivan)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 ebolify_bytecode_constants (XCDR (ivan));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 if (CONSP (doc))
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 assert (!purify_flag); /* should have been handled in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 read_compiled_function() */
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 456
diff changeset
492 doc = pas_de_holgazan_ici (fd, doc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 if (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 free_list (list);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 /* Close all descriptors in use for Fload_internal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 This is used when starting a subprocess. */
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 close_load_descs (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 LIST_LOOP (tail, Vload_descriptor_list)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
514 retry_close (XINT (XCAR (tail)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 Lisp_Object Vfile_domain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 #endif /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 Execute a file of Lisp code named FILE; no coding-system frobbing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 This function is identical to `load' except for the handling of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 support is not present, both functions are identical and ignore the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 CODESYS and USED-CODESYS arguments.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 If support for Mule exists in this Emacs, the file is decoded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 according to CODESYS; if omitted, no conversion happens. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 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
531 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
532 general be different from CODESYS if CODESYS specifies automatic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 encoding detection or end-of-line detection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
535 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
428
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 int fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 int source_only = 0;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
541 /* NEWER and OLDER are filenames w/o directory, used in loading messages
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
542 to e.g. warn of newer .el files when the .elc is being loaded. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 Lisp_Object newer = Qnil;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
544 Lisp_Object older = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 Lisp_Object handler = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 Lisp_Object found = Qnil;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
547 Lisp_Object retval;
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
548 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 int reading_elc = 0;
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
550 int from_require = EQ (nomessage, Qrequire);
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
551 int message_p = NILP (nomessage) || load_always_display_messages;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 struct stat s1, s2;
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
553 Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10);
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
554 int i;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
555 PROFILE_DECLARE ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
1266
b5a5863da615 [xemacs-hg @ 2003-02-07 00:54:17 by ben]
ben
parents: 1261
diff changeset
557 GCPRO4 (file, newer, older, found);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 CHECK_STRING (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
560 PROFILE_RECORD_ENTERING_SECTION (Qload_internal);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
561
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 /* If file name is magic, call the handler. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 handler = Ffind_file_name_handler (file, Qload);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 if (!NILP (handler))
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
565 {
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
566 retval = call5 (handler, Qload, file, noerror, nomessage, nosuffix);
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
567 goto done;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
568 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 /* Do this after the handler to avoid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 the need to gcpro noerror, nomessage and nosuffix.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (Below here, we care only whether they are nil or not.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 file = Fsubstitute_in_file_name (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 CHECK_SYMBOL (used_codesys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
577 if (noninteractive)
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
578 {
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
579 for (i = 0; i < load_in_progress * 2; i++)
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
580 spaces[i] = ' ';
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
581 spaces[i] = '\0';
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
582 }
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
583 else
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
584 spaces[0] = '\0';
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
585
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 /* Avoid weird lossage with null string as arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 since it would try to load a directory as a Lisp file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 Unix truly sucks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 if (XSTRING_LENGTH (file) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
591 Ibyte *foundstr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 int foundlen;
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 fd = locate_file (Vload_path, file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 ((!NILP (nosuffix)) ? Qnil :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 build_string (load_ignore_elc_files ? ".el:" :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 ".elc:.el:")),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 &found,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
603 if (NILP (noerror))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
604 signal_error (Qfile_error, "Cannot open load file", file);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 {
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
607 retval = Qnil;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
608 goto done;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
612 foundstr = alloca_ibytes (XSTRING_LENGTH (found) + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
613 qxestrcpy (foundstr, XSTRING_DATA (found));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
614 foundlen = qxestrlen (foundstr);
428
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 /* The omniscient JWZ thinks this is worthless, but I beg to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 differ. --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 if (load_ignore_elc_files)
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
619 newer = Ffile_name_nondirectory (found);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
620 else if ((load_warn_when_source_newer ||
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
621 load_ignore_out_of_date_elc_files) &&
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 !memcmp (".elc", foundstr + foundlen - 4, 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
624 if (! qxe_fstat (fd, &s1)) /* can't fail, right? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 int result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 /* temporarily hack the 'c' off the end of the filename */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 foundstr[foundlen - 1] = '\0';
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
629 result = qxe_stat (foundstr, &s2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 if (result >= 0 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
632 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
633 /* .elc exists and is out-of-date wrt .el */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
634 Lisp_Object el_name = make_string (foundstr, foundlen - 1);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
635 struct gcpro nngcpro1;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
636 NNGCPRO1 (el_name);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
637 newer = Ffile_name_nondirectory (el_name);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
638 if (load_ignore_out_of_date_elc_files)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
639 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
640 int newfd =
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
641 locate_file_open_or_access_file
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
642 (XSTRING_DATA (el_name), -1);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
643
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
644 if (newfd >= 0)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
645 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
646 older = Ffile_name_nondirectory (found);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
647 found = el_name;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
648 retry_close (fd);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
649 fd = newfd;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
650 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
651 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
652 NNUNGCPRO;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
653 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 /* put the 'c' back on (kludge-o-rama) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 foundstr[foundlen - 1] = 'c';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 else if (load_warn_when_source_only &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 /* `found' ends in ".el" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 !memcmp (".el", foundstr + foundlen - 3, 3) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 /* `file' does not end in ".el" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 memcmp (".el",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 3))
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
665 source_only = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 reading_elc = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
671 #define PRINT_LOADING_MESSAGE_1(loading, done) \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
672 do { \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
673 if (load_ignore_elc_files) \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
674 { \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
675 if (message_p) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
676 message (loading done, spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
677 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
678 found : newer)); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
679 } \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
680 else if (!NILP (older)) \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
681 { \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
682 assert (load_ignore_out_of_date_elc_files); \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
683 message (loading done " (file %s is out-of-date)", spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
684 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
685 found : newer), \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
686 XSTRING_DATA (older)); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
687 } \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
688 else if (!NILP (newer)) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
689 message (loading done " (file %s is newer)", spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
690 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
691 found : file), \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
692 XSTRING_DATA (newer)); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
693 else if (source_only) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
694 message (loading done " (file %s.elc does not exist)", spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
695 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
696 found : file), \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
697 XSTRING_DATA (Ffile_name_nondirectory (file))); \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
698 else if (message_p) \
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
699 message (loading done, spaces, \
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
700 XSTRING_DATA (load_show_full_path_in_messages ? \
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
701 found : file)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
704 #define PRINT_LOADING_MESSAGE(done) \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
705 do { \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
706 if (from_require) \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
707 PRINT_LOADING_MESSAGE_1 ("%sRequiring %s...", done); \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
708 else \
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
709 PRINT_LOADING_MESSAGE_1 ("%sLoading %s...", done); \
780
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
710 } while (0)
578cb2932d72 [xemacs-hg @ 2002-03-18 10:07:30 by ben]
ben
parents: 771
diff changeset
711
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 PRINT_LOADING_MESSAGE ("");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
4608
1e3cf11fa27d Make #$ truly read-only for Lisp; check this in the test suite.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4483
diff changeset
714 LISP_READONLY (found) = 1;
1e3cf11fa27d Make #$ truly read-only for Lisp; check this in the test suite.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4483
diff changeset
715
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 /* Lisp_Object's must be malloc'ed, not stack-allocated */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 Lisp_Object lispstream = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
719 const int block_size = 8192;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 NGCPRO1 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 /* 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
725 files aren't really all that big. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 block_size);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
728 lispstream = make_coding_input_stream
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
729 (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
730 CODING_DECODE, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 block_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 /* NOTE: Order of these is very important. Don't rearrange them. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
734 internal_bind_int (&load_in_progress, 1 + load_in_progress);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 record_unwind_protect (load_unwind, lispstream);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
736 internal_bind_lisp_object (&Vload_descriptor_list,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
737 Fcons (make_int (fd), Vload_descriptor_list));
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
738 internal_bind_lisp_object (&Vload_file_name_internal, found);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
739 /* this is not a simple internal_bind. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 record_unwind_protect (load_force_doc_string_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 Vload_force_doc_string_list);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
742 Vload_force_doc_string_list = Qnil;
4608
1e3cf11fa27d Make #$ truly read-only for Lisp; check this in the test suite.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4483
diff changeset
743 /* load-file-name is not read-only to Lisp. */
1e3cf11fa27d Make #$ truly read-only for Lisp; check this in the test suite.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4483
diff changeset
744 internal_bind_lisp_object (&Vload_file_name, Fcopy_sequence(found));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 #ifdef I18N3
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
746 /* set it to nil; a call to #'domain will set it. */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
747 internal_bind_lisp_object (&Vfile_domain, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749
4448
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
750 /* Is there a #!? If so, read it, and unread ;!.
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
751
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
752 GNU implement this by treating any #! anywhere in the source text as
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
753 commenting out the whole line. */
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
754 {
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
755 char shebangp[2];
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
756 int num_read;
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
757
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
758 num_read = Lstream_read (XLSTREAM (lispstream), shebangp,
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
759 sizeof(shebangp));
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
760 if (sizeof(shebangp) == num_read
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
761 && 0 == strncmp("#!", shebangp, sizeof(shebangp)))
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
762 {
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
763 shebangp[0] = ';';
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
764 }
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
765
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
766 Lstream_unread (XLSTREAM (lispstream), shebangp, num_read);
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
767 }
fd8a9a4d81d9 Support #!, to allow XEmacs to be called as a script interpreter.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4329
diff changeset
768
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 /* Now determine what sort of ELC file we're reading in. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
770 internal_bind_int (&load_byte_code_version, load_byte_code_version);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 if (reading_elc)
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 char elc_header[8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 int num_read;
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 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 if (num_read < 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 || strncmp (elc_header, ";ELC", 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 /* Huh? Probably not a valid ELC file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 load_byte_code_version = 100; /* no Ebolification needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 load_byte_code_version = elc_header[4];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 load_byte_code_version = 100; /* no Ebolification needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 readevalloop (lispstream, file, Feval, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 if (!NILP (used_codesys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 Fset (used_codesys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 XCODING_SYSTEM_NAME
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
794 (coding_stream_detected_coding_system (XLSTREAM (lispstream))));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
795 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 /* #### Disgusting kludge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 /* Run any load-hooks for this file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 /* #### An even more disgusting kludge. There is horrible code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 /* that is relying on the fact that dumped lisp files are found */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 /* via `load-path' search. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 Lisp_Object name = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
809 if (!NILP (Ffile_name_absolute_p (file)))
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
810 name = Ffile_name_nondirectory (file);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
812 tem = Fassoc (name, Vafter_load_alist);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 NGCPRO1 (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 tem = Fcons (Qprogn, Fcdr (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 Feval (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 if (!noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 PRINT_LOADING_MESSAGE ("done");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
828 retval = Qt;
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
829 done:
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
830 PROFILE_RECORD_EXITING_SECTION (Qload_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 UNGCPRO;
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
832 return retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 /* ------------------------------- */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 /* locate_file */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 decode_mode_1 (Lisp_Object mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 if (EQ (mode, Qexists))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 return F_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 else if (EQ (mode, Qexecutable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 return X_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 else if (EQ (mode, Qwritable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 return W_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 else if (EQ (mode, Qreadable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 return R_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 else if (INTP (mode))
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 check_int_range (XINT (mode), 0, 7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 return XINT (mode);
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 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
857 invalid_argument ("Invalid value", mode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 return 0; /* unreached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 decode_mode (Lisp_Object mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 return R_OK;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 else if (CONSP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 int mask = 0;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
869 EXTERNAL_LIST_LOOP_2 (elt, mode)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
870 mask |= decode_mode_1 (elt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 return mask;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 return decode_mode_1 (mode);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 Search for FILENAME through PATH-LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 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
881 file name when searching.
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 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
884 requirements. Allowed symbols are `exists', `executable', `writable', and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 `readable'. If MODE is nil, it defaults to `readable'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
887 Filenames are checked against `load-suppress-alist' to determine if they
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
888 should be ignored.
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
889
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 `locate-file' keeps hash tables of the directories it searches through,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 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
892 the face of a changing and unpredictable environment, but can occasionally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 get tripped up. In this case, you will have to call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 `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
895 for details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (filename, path_list, suffixes, mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 Lisp_Object tp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 if (LISTP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
906 EXTERNAL_LIST_LOOP_2 (elt, suffixes)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
907 CHECK_STRING (elt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 CHECK_STRING (suffixes);
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 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 return tp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 /* Recalculate the hash table for the given string. DIRECTORY should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 better have been through Fexpand_file_name() by now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 locate_file_refresh_hashing (Lisp_Object directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 Lisp_Object hash =
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
923 make_directory_hash_table (XSTRING_DATA (directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 if (!NILP (hash))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 Fputhash (directory, hash, Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 /* find the hash table for the given directory, recalculating if necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 locate_file_find_directory_hash_table (Lisp_Object directory)
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 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 if (NILP (hash))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 return locate_file_refresh_hashing (directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 /* The SUFFIXES argument in any of the locate_file* functions can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 nil, a list, or a string (for backward compatibility), with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 following semantics:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 a) nil - no suffix, just search for file name intact
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 (semantically different from "empty suffix list", which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 would be meaningless.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 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
950 must be a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 c) string - colon-separated suffixes to append to file name (backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 compatibility).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 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
955 function for each suffix shouldn't slow things down, since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 locate_file is rarely called with enough suffixes for funcalls to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 make any difference. */
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 /* 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
960 char * containing the current file name, and ARG. Mapping stops when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 FUN returns non-zero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
964 int (*fun) (Ibyte *, void *),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
968 Ibyte *fn;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 int fn_len, max;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 /* Calculate maximum size of any filename made from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 this path element/specified file name and any possible suffix. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 if (CONSP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 /* We must traverse the list, so why not do it right. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 max = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 if (XSTRING_LENGTH (XCAR (tail)) > max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 max = XSTRING_LENGTH (XCAR (tail));
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 else if (NILP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 max = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 /* Just take the easy way out */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 max = XSTRING_LENGTH (suffixes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 fn_len = XSTRING_LENGTH (filename);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
991 fn = alloca_ibytes (max + fn_len + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
992 memcpy (fn, XSTRING_DATA (filename), fn_len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 /* Loop over suffixes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 if (!STRINGP (suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 if (NILP (suffixes))
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 /* Case a) discussed in the comment above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 fn[fn_len] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 /* Case b) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 LIST_LOOP (tail, suffixes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 XSTRING_LENGTH (XCAR (tail)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 /* Case c) */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1021 const Ibyte *nsuffix = XSTRING_DATA (suffixes);
428
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 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1025 Ibyte *esuffix = qxestrchr (nsuffix, ':');
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1026 Bytecount lsuffix = esuffix ? esuffix - nsuffix :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1027 qxestrlen (nsuffix);
428
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 /* 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
1030 qxestrncpy (fn + fn_len, nsuffix, lsuffix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 fn[fn_len + lsuffix] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 if ((*fun) (fn, arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 /* Advance to next suffix. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 if (esuffix == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 nsuffix += lsuffix + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1044 struct locate_file_in_directory_mapper_closure
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1045 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 int fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 Lisp_Object *storeptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1051 /* open() or access() a file to be returned by locate_file(). if
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1052 ACCESS_MODE >= 0, do an access() with that mode, else open(). Does
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1053 various magic, e.g. opening the file read-only and binary and setting
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1054 the close-on-exec flag on the file. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1055
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1056 static int
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1057 locate_file_open_or_access_file (Ibyte *fn, int access_mode)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1058 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1059 int val;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1060
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1061 /* Check that we can access or open it. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1062 if (access_mode >= 0)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1063 val = qxe_access (fn, access_mode);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1064 else
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1065 {
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1066 val = qxe_open (fn, O_RDONLY | OPEN_BINARY, 0);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1067
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1068 #ifndef WIN32_NATIVE
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1069 if (val >= 0)
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1070 /* If we actually opened the file, set close-on-exec flag
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1071 on the new descriptor so that subprocesses can't whack
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1072 at it. */
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1073 (void) fcntl (val, F_SETFD, FD_CLOEXEC);
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1074 #endif
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1075 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1076
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1077 return val;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1078 }
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1079
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1081 locate_file_in_directory_mapper (Ibyte *fn, void *arg)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 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
1084 (struct locate_file_in_directory_mapper_closure *) arg;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 struct stat st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 /* Ignore file if it's a directory. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1088 if (qxe_stat (fn, &st) >= 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 && (st.st_mode & S_IFMT) != S_IFDIR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 /* Check that we can access or open it. */
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
1092 closure->fd = locate_file_open_or_access_file (fn, closure->mode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 if (closure->fd >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 {
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1096 if (!check_if_suppressed (fn, Qnil))
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1097 {
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1098 /* We succeeded; return this descriptor and filename. */
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1099 if (closure->storeptr)
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1100 *closure->storeptr = build_intstring (fn);
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1101
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1102 return 1;
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1103 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 /* Keep mapping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 not have been expanded. */
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 Lisp_Object suffixes, Lisp_Object *storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 int mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 struct locate_file_in_directory_mapper_closure closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 Lisp_Object filename = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 GCPRO3 (directory, str, filename);
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 filename = Fexpand_file_name (str, directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 /* If there are non-absolute elts in PATH (eg ".") */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 /* Of course, this could conceivably lose if luser sets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 default-directory to be something non-absolute ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 if (NILP (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 /* NIL means current directory */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 filename = current_buffer->directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 filename = Fexpand_file_name (filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 current_buffer->directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 if (NILP (Ffile_name_absolute_p (filename)))
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 /* Give up on this directory! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 closure.fd = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 closure.storeptr = storeptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 closure.mode = mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1150 locate_file_map_suffixes (filename, suffixes,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1151 locate_file_in_directory_mapper,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 return closure.fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 /* 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
1159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 Lisp_Object suffixes, Lisp_Object *storeptr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 int mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 int absolute = !NILP (Ffile_name_absolute_p (str));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1168 EXTERNAL_LIST_LOOP_2 (elt, path)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1170 int val = locate_file_in_directory (elt, str, suffixes, storeptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 if (absolute)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 }
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 static int
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1181 locate_file_construct_suffixed_files_mapper (Ibyte *fn, void *arg)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1183 Lisp_Object *tail = (Lisp_Object *) arg;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1184 *tail = Fcons (build_intstring (fn), *tail);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 /* Construct a list of all files to search for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 It makes sense to have this despite locate_file_map_suffixes()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 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
1191 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
1192 path component. See locate_file(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 locate_file_construct_suffixed_files (Lisp_Object filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 Lisp_Object suffixes)
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 Lisp_Object tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 GCPRO1 (tail);
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 locate_file_map_suffixes (filename, suffixes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 locate_file_construct_suffixed_files_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 &tail);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 return Fnreverse (tail);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 Clear the hash records for the specified list of directories.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 `locate-file' uses a hashing scheme to speed lookup, and will correctly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 track the following environmental changes:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 -- changes of any sort to the list of directories to be searched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 -- addition and deletion of non-shadowing files (see below) from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 directories in the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 -- byte-compilation of a .el file into a .elc file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 `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
1221 \(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
1222 In this case, you must call `locate-file-clear-hashing'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 If 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
1225 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
1226 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 (path))
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 if (EQ (path, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 Fclrhash (Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1233 EXTERNAL_LIST_LOOP_2 (elt, path)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1235 Lisp_Object pathel = Fexpand_file_name (elt, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 Fremhash (pathel, Vlocate_file_hash_table);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 return Qnil;
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 /* Search for a file whose name is STR, looking in directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 in the Lisp list PATH, and trying suffixes from SUFFIXES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 SUFFIXES is a list of possible suffixes, or (for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 compatibility) a string containing possible suffixes separated by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 colons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 On success, returns a file descriptor. On failure, returns -1.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 MODE nonnegative means don't open the files,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 just look for one for which access(file,MODE) succeeds. In this case,
951
93e076dd7825 [xemacs-hg @ 2002-08-02 15:35:49 by james]
james
parents: 867
diff changeset
1251 returns a nonnegative value on success. On failure, returns -1.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1253 If STOREPTR is non-nil, it points to a slot where the name of
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 the file actually found should be stored as a Lisp string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 Nil is stored there on failure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 Called openp() in FSFmacs. */
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 Lisp_Object *storeptr, int mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 Lisp_Object suffixtab = Qnil;
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1265 Lisp_Object pathel_expanded;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 int val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
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 if (storeptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 *storeptr = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 /* 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
1273 unless some caller has fucked up. There are known instances that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 call us with build_string("foo:bar") as SUFFIXES, though. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 GCPRO4 (path, str, suffixes, suffixtab);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 /* if this filename has directory components, it's too complicated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 to try and use the hash tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 if (!NILP (Ffile_name_directory (str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1288 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1289 EXTERNAL_LIST_LOOP_2 (pathel, path)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1290 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1291 Lisp_Object hash_table;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1292 int found = 0;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1293
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1294 /* If this path element is relative, we have to look by hand. */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1295 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1296 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1297 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1298 mode);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1299 if (val >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1301 UNGCPRO;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1302 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 }
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1304 continue;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1305 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1306
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1307 pathel_expanded = Fexpand_file_name (pathel, Qnil);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1308 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1309
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1310 if (!NILP (hash_table))
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1311 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1312 /* Loop over suffixes. */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1313 LIST_LOOP_2 (elt, suffixtab)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1314 if (!NILP (Fgethash (elt, hash_table, Qnil)))
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1315 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1316 found = 1;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1317 break;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1318 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1319 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1320
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1321 if (found)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1322 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1323 /* This is a likely candidate. Look by hand in this directory
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1324 so we don't get thrown off if someone byte-compiles a file. */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1325 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1326 mode);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1327 if (val >= 0)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1328 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1329 UNGCPRO;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1330 return val;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1331 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1332
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1333 /* Hmm ... the file isn't actually there. (Or possibly it's
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1334 a directory ...) So refresh our hashing. */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1335 locate_file_refresh_hashing (pathel_expanded);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1336 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1337 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 /* 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
1341 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 if (val >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 /* Sneaky user added a file without telling us. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 Flocate_file_clear_hashing (path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 return val;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 #ifdef LOADHIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 /* 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
1356 into the load_history variable. The details depend on whether
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 the source has an associated file name or not. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 build_load_history (int loading, Lisp_Object source)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 REGISTER Lisp_Object tail, prev, newelt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 REGISTER Lisp_Object tem, tem2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 int foundit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 #if !defined(LOADHIST_DUMPED)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 /* Don't bother recording anything for preloaded files. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 if (purify_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 tail = Vload_history;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 foundit = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 tem = Fcar (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 /* Find the feature's previous assoc list... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 if (internal_equal (source, Fcar (tem), 0))
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 foundit = 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 /* If we're loading, remove it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 if (loading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 Vload_history = Fcdr (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 Fsetcdr (prev, Fcdr (tail));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 /* Otherwise, cons on new symbols that are not already members. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 tem2 = Vcurrent_load_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 while (CONSP (tem2))
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 newelt = XCAR (tem2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 if (NILP (Fmemq (newelt, tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 Fsetcar (tail, Fcons (Fcar (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 Fcons (newelt, Fcdr (tem))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 tem2 = XCDR (tem2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 tail = Fcdr (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 /* 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
1418 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
1419 an existing member for the current source. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 if (loading || !foundit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 Vload_history);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 #else /* !LOADHIST */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 #define build_load_history(x,y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 #endif /* !LOADHIST */
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 readevalloop (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 Lisp_Object sourcename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 Lisp_Object (*evalfun) (Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 int printflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1437 REGISTER Ichar c;
1849
21549d437f09 [xemacs-hg @ 2004-01-03 21:54:41 by james]
james
parents: 1292
diff changeset
1438 Lisp_Object val = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 struct buffer *b = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 if (BUFFERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 b = XBUFFER (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 else if (MARKERP (readcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 b = XMARKER (readcharfun)->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 /* Don't do this. It is not necessary, and it needlessly exposes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 READCHARFUN (which can be a stream) to Lisp. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 /*specbind (Qstandard_input, readcharfun);*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
1452 internal_bind_lisp_object (&Vcurrent_load_list, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 GCPRO2 (val, sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 LOADHIST_ATTACH (sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 QUIT;
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 if (b != 0 && !BUFFER_LIVE_P (b))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1466 invalid_operation ("Reading from killed buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 if (c == ';')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 /* Skip comment */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 while ((c = readchar (readcharfun)) != '\n' && c != -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 break;
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 /* Ignore whitespace here, so we can detect eof. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1483 unreadchar (readcharfun, c);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1484 Vread_objects = Qnil;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1485 if (NILP (Vload_read_function))
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1486 val = read0 (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 else
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
1488 val = call1 (Vload_read_function, readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 val = (*evalfun) (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 if (printflag)
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 Vvalues = Fcons (val, Vvalues);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 if (EQ (Vstandard_output, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 Fprin1 (val, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 Fprint (val, Qnil);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 build_load_history (LSTREAMP (readcharfun) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 /* This looks weird, but it's what's in FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 sourcename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1506 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 Execute BUFFER as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 Programs can pass two arguments, BUFFER and PRINTFLAG.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 BUFFER is the buffer to evaluate (nil means use current buffer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 PRINTFLAG controls printing of output:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1514 nil means discard it; anything else is a stream for printing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 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
1517 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
1518 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1519 (buffer, printflag))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 Lisp_Object tem, buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1525 if (NILP (buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 buf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1528 buf = Fget_buffer (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 if (NILP (buf))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1530 invalid_argument ("No such buffer", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 if (NILP (printflag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 tem = printflag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 specbind (Qstandard_output, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 record_unwind_protect (save_excursion_restore, save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 readevalloop (buf, XBUFFER (buf)->filename, Feval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 !NILP (printflag));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1542 return unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 #if 0
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1546 DEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 Execute the current buffer as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 Programs can pass argument PRINTFLAG which controls printing of output:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 nil means discard it; anything else is stream for print.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 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
1552 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
1553 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 (printflag))
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 code omitted;
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 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 Execute the region as Lisp code.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1562 When called from programs, expects two arguments START and END
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 giving starting and ending indices in the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 of the text to be executed.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1565 Programs can pass third optional argument STREAM which controls output:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 nil means discard it; anything else is stream for printing it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 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
1569 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
1570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 Note: Before evaling the region, this function narrows the buffer to it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 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
1573 see some text temporarily disappear because of this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1575 (start, end, stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 Lisp_Object cbuf = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1582 if (NILP (stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1585 tem = stream;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 specbind (Qstandard_output, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1588 if (NILP (stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 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
1590 record_unwind_protect (save_restriction_restore,
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 831
diff changeset
1591 save_restriction_save (current_buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1593 /* This both uses start and checks its type. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1594 Fgoto_char (start, cbuf);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1595 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1597 !NILP (stream));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1599 return unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 DEFUN ("read", Fread, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 Read one Lisp expression as text from STREAM, return as Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 If STREAM is nil, use the value of `standard-input' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 STREAM or the value of `standard-input' may be:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 a buffer (read from point and advance it)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 a marker (read from where it points and advance it)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 a function (call it with no arguments for each character,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 call it with a char as argument to push a char back)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 a string (takes text from string, starting at the beginning)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 t (read text line using minibuffer and use it).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 if (NILP (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 stream = Vstandard_input;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 if (EQ (stream, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 stream = Qread_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 if (EQ (stream, Qread_char))
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 Lisp_Object val = call1 (Qread_from_minibuffer,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1628 build_msg_string ("Lisp expression: "));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 return Fcar (Fread_from_string (val, Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 if (STRINGP (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 return Fcar (Fread_from_string (stream, Qnil, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 return read0 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 Read one Lisp expression which is represented as text by STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 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
1642 they default to 0 and (length STRING) respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 (string, start, end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 Bytecount startval, endval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 Lisp_Object lispstream = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 GCPRO1 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 get_string_range_byte (string, start, end, &startval, &endval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 GB_HISTORICAL_STRING_BEHAVIOR);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 lispstream = make_lisp_string_input_stream (string, startval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 endval - startval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 tem = read0 (lispstream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 /* Yeah, it's ugly. Gonna make something of it?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 At least our reader is reentrant ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 tem =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 (Fcons (tem, make_int
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 780
diff changeset
1668 (string_index_byte_to_char
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1669 (string,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 Lstream_delete (XLSTREAM (lispstream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 /* Use this for recursive reads, in contexts where internal tokens
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 are not allowed. See also read1(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 read0 (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 Lisp_Object val = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 if (CONSP (val) && UNBOUNDP (XCAR (val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1687 Ichar c = XCHAR (XCDR (val));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1688 free_cons (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 list1 (Fchar_to_string (make_char (c))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 }
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1695
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1696 /* A Unicode escape, as in C# (though we only permit them in strings
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1697 and characters, not arbitrarily in the source code.) */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1698 static Ichar
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1699 read_unicode_escape (Lisp_Object readcharfun, int unicode_hex_count)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1700 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1701 REGISTER Ichar i = 0, c;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1702 REGISTER int count = 0;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1703 Lisp_Object lisp_char;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1704 while (++count <= unicode_hex_count)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1705 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1706 c = readchar (readcharfun);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1707 /* Remember, can't use isdigit(), isalpha() etc. on Ichars */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1708 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1709 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1710 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1711 else
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1712 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1713 syntax_error ("Non-hex digit used for Unicode escape",
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1714 make_char (c));
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1715 break;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1716 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1717 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1718
4268
75d0292c1bff [xemacs-hg @ 2007-11-14 19:41:04 by aidan]
aidan
parents: 4096
diff changeset
1719 if (i >= 0x110000 || i < 0)
4096
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1720 {
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1721 syntax_error ("Not a Unicode code point", make_int(i));
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1722 }
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1723
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1724 lisp_char = Funicode_to_char(make_int(i), Qnil);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1725
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1726 if (EQ(Qnil, lisp_char))
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1727 {
4096
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1728 /* Will happen on non-Mule. Silent corruption is what happens
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1729 elsewhere, and we used to do that to be consistent, but GNU error,
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1730 so people writing portable code need to be able to handle that, and
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1731 given a choice I prefer that behaviour.
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1732
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1733 An undesirable aspect to this error is that the code point is shown
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1734 as a decimal integer, which is mostly unreadable. */
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1735 syntax_error ("Unsupported Unicode code point", make_int(i));
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1736 }
4096
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1737
1abf84db2c7f [xemacs-hg @ 2007-08-04 20:00:10 by aidan]
aidan
parents: 3666
diff changeset
1738 return XCHAR(lisp_char);
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1739 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1740
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1742 static Ichar
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 read_escape (Lisp_Object readcharfun)
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 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1746 Ichar c = readchar (readcharfun);
428
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 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1749 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
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 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 case 'a': return '\007';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 case 'b': return '\b';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 case 'd': return 0177;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 case 'e': return 033;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 case 'f': return '\f';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 case 'n': return '\n';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 case 'r': return '\r';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 case 't': return '\t';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 case 'v': return '\v';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 case '\n': return -1;
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 case 'M':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1767 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 if (c != '-')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1769 syntax_error ("Invalid escape character syntax", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1772 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 return c | 0200;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 /* Originally, FSF_KEYS provided a degree of FSF Emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 compatibility by defining character "modifiers" alt, super,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 hyper and shift to infest the characters (i.e. integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 However, this doesn't cut it for XEmacs 20, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 distinguishes characters from integers. Without Mule, ?\H-a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 simply returns ?a because every character is clipped into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 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
1785 produces an illegal character, and moves us to crash-land.
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 For these reasons, FSF_KEYS hack is useless and without hope
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 of ever working under XEmacs 20. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 #ifdef FSF_KEYS
831
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1790 /* Deleted */
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1791 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 case 'C':
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 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1796 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 if (c != '-')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1798 syntax_error ("Invalid escape character syntax", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 case '^':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1802 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 c = read_escape (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 /* FSFmacs junk for non-ASCII controls.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 Not used here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 if (c == '?')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 return 0177;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 return c & (0200 | 037);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 case '0':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 case '1':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 case '2':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 case '3':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 case '4':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 case '5':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 case '6':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 case '7':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 /* An octal escape, as in ANSI C. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1822 REGISTER Ichar i = c - '0';
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 REGISTER int count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 while (++count < 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 i = (i << 3) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 else
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 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 break;
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 }
831
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1834 if (i >= 0400)
3367
84ee3ca77e7f [xemacs-hg @ 2006-04-29 14:36:49 by aidan]
aidan
parents: 2857
diff changeset
1835 syntax_error ("Non-ISO-8859-1 character specified with octal escape",
831
5d09ddada9ae [xemacs-hg @ 2002-05-09 07:15:20 by ben]
ben
parents: 826
diff changeset
1836 make_int (i));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 return i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 case 'x':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 /* 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
1842 characters to be read this way. What is "\x4e03" supposed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 mean, anyways, if the internal representation is hidden?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 This is also consistent with the treatment of octal escapes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1846 REGISTER Ichar i = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 REGISTER int count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 while (++count <= 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 c = readchar (readcharfun);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1851 /* Remember, can't use isdigit(), isalpha() etc. on Ichars */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 break;
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 }
4483
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1861
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1862 if (count == 3)
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1863 {
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1864 c = readchar (readcharfun);
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1865 if ((c >= '0' && c <= '9') ||
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1866 (c >= 'a' && c <= 'f') ||
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1867 (c >= 'A' && c <= 'F'))
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1868 {
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1869 Lisp_Object args[2];
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1870
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1871 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1872 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1873 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1874
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1875 args[0] = build_string ("?\\x%x");
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1876 args[1] = make_int (i);
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1877 syntax_error ("Overlong hex character escape",
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1878 Fformat (2, args));
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1879 }
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1880 unreadchar (readcharfun, c);
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1881 }
7869173584fc Error on over-long hex character escapes.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4450
diff changeset
1882
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 return i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 }
3367
84ee3ca77e7f [xemacs-hg @ 2006-04-29 14:36:49 by aidan]
aidan
parents: 2857
diff changeset
1885 case 'U':
84ee3ca77e7f [xemacs-hg @ 2006-04-29 14:36:49 by aidan]
aidan
parents: 2857
diff changeset
1886 /* Post-Unicode-2.0: Up to eight hex chars */
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1887 return read_unicode_escape(readcharfun, 8);
3367
84ee3ca77e7f [xemacs-hg @ 2006-04-29 14:36:49 by aidan]
aidan
parents: 2857
diff changeset
1888 case 'u':
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1889 /* Unicode-2.0 and before; four hex chars. */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
1890 return read_unicode_escape(readcharfun, 4);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 return c;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 static Bytecount
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1901 read_atom_0 (Lisp_Object readcharfun, Ichar firstchar, int *saw_a_backslash)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1904 Ichar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 *saw_a_backslash = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 while (c > 040 /* #### - comma should be here as should backquote */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 && !(c == '\"' || c == '\'' || c == ';'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 || c == '(' || c == ')'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 || c == '[' || c == ']' || c == '#'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1919 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 *saw_a_backslash = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 }
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1922 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 if (c >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 /* blasted terminating 0 */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1930 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 Lstream_flush (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1936 static Lisp_Object parse_integer (const Ibyte *buf, Bytecount len, int base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 read_atom (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1940 Ichar firstchar,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 int uninterned_symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 int saw_a_backslash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 char *read_ptr = (char *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 /* Is it an integer? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 if (! (saw_a_backslash || uninterned_symbol))
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 /* If a token had any backslashes in it, it is disqualified from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 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
1954 symbol, as is \123 (which is the way (intern "123") prints).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 Also, if token was preceded by #:, it's always a symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 char *p = read_ptr + len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 char *p1 = read_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 if (*p1 == '+' || *p1 == '-') p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 if (p1 != p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 int c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 while (p1 != p && (c = *p1) >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 /* Integers can have trailing decimal points. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 if (p1 > read_ptr && p1 < p && *p1 == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 p1++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 if (p1 == p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 /* It is an integer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 if (p1[-1] == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 p1[-1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 int number = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 if (sizeof (int) == sizeof (EMACS_INT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 number = atoi (read_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 else if (sizeof (long) == sizeof (EMACS_INT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 number = atol (read_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
1983 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 return make_int (number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 #else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1987 return parse_integer ((Ibyte *) read_ptr, len, 10);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
1991 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
1992 if (isratio_string (read_ptr))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
1993 {
2013
f2fdfc131770 [xemacs-hg @ 2004-04-14 22:50:52 by james]
james
parents: 2010
diff changeset
1994 /* GMP ratio_set_string has no effect with initial + sign */
2010
a9cdbfb4716e [xemacs-hg @ 2004-04-13 15:38:30 by james]
james
parents: 1995
diff changeset
1995 if (*read_ptr == '+')
a9cdbfb4716e [xemacs-hg @ 2004-04-13 15:38:30 by james]
james
parents: 1995
diff changeset
1996 read_ptr++;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
1997 ratio_set_string (scratch_ratio, read_ptr, 0);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
1998 ratio_canonicalize (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
1999 return Fcanonicalize_number (make_ratio_rt (scratch_ratio));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2000 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2001 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 if (isfloat_string (read_ptr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 return make_float (atof (read_ptr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005
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 Lisp_Object sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 if (uninterned_symbol)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2009 sym = Fmake_symbol ( make_string ((Ibyte *) read_ptr, len));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2012 Lisp_Object name = make_string ((Ibyte *) read_ptr, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 sym = Fintern (name, Qnil);
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 sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 static Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2021 parse_integer (const Ibyte *buf, Bytecount len, int base)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2023 const Ibyte *lim = buf + len;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2024 const Ibyte *p = buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 EMACS_UINT num = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 int negativland = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 if (*p == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 negativland = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 else if (*p == '+')
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 p++;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 if (p == lim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 goto loser;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 for (; (p < lim) && (*p != '\0'); p++)
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 int c = *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 EMACS_UINT onum;
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 if (isdigit (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 c = c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 else if (isupper (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 c = c - 'A' + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 else if (islower (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 c = c - 'a' + 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 goto loser;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 if (c < 0 || c >= base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 goto loser;
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 onum = num;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 num = num * base + c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 if (num < onum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 Lisp_Object result = make_int (int_result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 if (num && ((XINT (result) < 0) != negativland))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 if (XINT (result) != int_result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 goto overflow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 return result;
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 overflow:
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2074 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2075 {
4329
d9eb5ea14f65 Provide %b in #'format; use it for converting between ints and bit vectors.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4268
diff changeset
2076 bignum_set_string (scratch_bignum, (const char *) buf, base);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2077 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2078 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2079 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2081 list3 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 ("Integer constant overflow in reader"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 make_string (buf, len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 make_int (base)));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2085 #endif /* HAVE_BIGNUM */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 loser:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2088 list3 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 ("Invalid integer constant in reader"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 make_string (buf, len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 make_int (base)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 read_integer (Lisp_Object readcharfun, int base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 int saw_a_backslash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 return (parse_integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 ((saw_a_backslash)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 ? 0 /* make parse_integer signal error */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 : len),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 base));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 read_bit_vector (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2113 Lisp_Object val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2117 unsigned char bit;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2118 Ichar c = readchar (readcharfun);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2119 if (c == '0')
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2120 bit = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2121 else if (c == '1')
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2122 bit = 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2123 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2124 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2125 if (c >= 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2126 unreadchar (readcharfun, c);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2127 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2128 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2129 Dynarr_add (dyn, bit);
428
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
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2132 val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2133 Dynarr_length (dyn));
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2134 Dynarr_free (dyn);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2135
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
2136 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 /* structures */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 struct structure_type *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 define_structure_type (Lisp_Object type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 int (*validate) (Lisp_Object data,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
2146 Error_Behavior errb),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 Lisp_Object (*instantiate) (Lisp_Object data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 struct structure_type st;
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 st.type = type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 st.keywords = Dynarr_new (structure_keyword_entry);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 st.validate = validate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 st.instantiate = instantiate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 Dynarr_add (the_structure_type_dynarr, st);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156
4844
91b3d00e717f Various cleanups for Dynarr code, from Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
2157 return Dynarr_lastp (the_structure_type_dynarr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 int (*validate) (Lisp_Object keyword,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 Lisp_Object value,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
2164 Error_Behavior errb))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 struct structure_keyword_entry en;
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 en.keyword = keyword;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 en.validate = validate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 Dynarr_add (st->keywords, en);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 static struct structure_type *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 recognized_structure_type (Lisp_Object type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 if (EQ (st->type, type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 return st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 read_structure (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2191 Ichar c = readchar (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 Lisp_Object orig_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 Lisp_Object already_seen = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 int keyword_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 struct structure_type *st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 GCPRO2 (orig_list, already_seen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 if (c != '(')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2201 RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 list = read_list (readcharfun, ')', 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 orig_list = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 int len = XINT (Flength (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 if (len == 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2207 RETURN_UNGCPRO (continuable_read_syntax_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 ("structure type not specified"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 if (!(len & 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 RETURN_UNGCPRO
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2211 (continuable_read_syntax_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 ("structures must have alternating keyword/value pairs"));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 st = recognized_structure_type (XCAR (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 if (!st)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2218 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 ("unrecognized structure type"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 XCAR (list))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 keyword_count = Dynarr_length (st->keywords);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 while (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 Lisp_Object keyword, value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 struct structure_keyword_entry *en = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 keyword = Fcar (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 list = Fcdr (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 value = Fcar (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 list = Fcdr (list);
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 if (!NILP (memq_no_quit (keyword, already_seen)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2237 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 ("structure keyword already seen"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 keyword)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 for (i = 0; i < keyword_count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 en = Dynarr_atp (st->keywords, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 if (EQ (keyword, en->keyword))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 }
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 if (i == keyword_count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2250 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 ("unrecognized structure keyword"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 keyword)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 RETURN_UNGCPRO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2257 list3 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 ("invalid value for structure keyword"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 keyword, value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 already_seen = Fcons (keyword, already_seen);
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 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2266 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 ("invalid structure initializer"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 orig_list)));
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 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 int terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 /* Get the next character; filter out whitespace and comments */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2280 static Ichar
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 reader_nextchar (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2284 Ichar c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 if (c < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2290 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 /* Ignore whitespace and control characters */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 if (c <= 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 return c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 case ';':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 /* Comment */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2320 static Lisp_Object
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2321 read_string (Lisp_Object readcharfun, Ichar delim, int raw,
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2322 int honor_unicode)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2323 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2324 #ifdef I18N3
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2325 /* #### If the input stream is translating, then the string
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2326 should be marked as translatable by setting its
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2327 `string-translatable' property to t. .el and .elc files
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2328 normally are translating input streams. See Fgettext()
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2329 and print_internal(). */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2330 #endif
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2331 Ichar c;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2332 int cancel = 0;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2333
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2334 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2335 while ((c = readchar(readcharfun)) >= 0 && c != delim)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2336 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2337 if (c == '\\')
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2338 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2339 if (raw)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2340 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2341 c = readchar(readcharfun);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2342 if (honor_unicode && ('u' == c || 'U' == c))
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2343 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2344 c = read_unicode_escape(readcharfun,
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2345 'U' == c ? 8 : 4);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2346 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2347 else
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2348 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2349 /* For raw strings, insert the
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2350 backslash and the next char, */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2351 Lstream_put_ichar(XLSTREAM
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2352 (Vread_buffer_stream),
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2353 '\\');
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2354 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2355 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2356 else
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2357 /* otherwise, backslash escapes the next char. */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2358 c = read_escape(readcharfun);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2359 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2360 /* c is -1 if \ newline has just been seen */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2361 if (c == -1)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2362 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2363 if (Lstream_byte_count
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2364 (XLSTREAM(Vread_buffer_stream)) ==
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2365 0)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2366 cancel = 1;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2367 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2368 else
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2369 Lstream_put_ichar(XLSTREAM
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2370 (Vread_buffer_stream),
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2371 c);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2372 QUIT;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2373 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2374 if (c < 0)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2375 return Fsignal(Qend_of_file,
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2376 list1(READCHARFUN_MAYBE(readcharfun)));
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2377
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2378 /* If purifying, and string starts with \ newline,
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2379 return zero instead. This is for doc strings
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2380 that we are really going to find in lib-src/DOC.nn.nn */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2381 if (purify_flag && NILP(Vinternal_doc_file_name)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2382 && cancel)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2383 return Qzero;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2384
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2385 Lstream_flush(XLSTREAM(Vread_buffer_stream));
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2386 return make_string(resizing_buffer_stream_ptr
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2387 (XLSTREAM(Vread_buffer_stream)),
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2388 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2389 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2390
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2391 static Lisp_Object
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2392 read_raw_string (Lisp_Object readcharfun)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2393 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2394 Ichar c;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2395 Ichar permit_unicode = 0;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2396
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2397 do {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2398 c = reader_nextchar(readcharfun);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2399 switch (c) {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2400 /* #r:engine"my sexy raw string" -- raw string w/ flags*/
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2401 /* case ':': */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2402 /* #ru"Hi there\u20AC \U000020AC" -- raw string, honouring Unicode. */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2403 case 'u':
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2404 case 'U':
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2405 permit_unicode = c;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2406 continue;
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2407
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2408 /* #r"my raw string" -- raw string */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2409 case '\"':
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2410 return read_string(readcharfun, '\"', 1, permit_unicode);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2411 /* invalid syntax */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2412 default:
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2413 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2414 if (permit_unicode)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2415 {
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2416 unreadchar(readcharfun, permit_unicode);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2417 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2418 unreadchar(readcharfun, c);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2419 return Fsignal(Qinvalid_read_syntax,
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2420 list1(build_string
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2421 ("unrecognized raw string syntax")));
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2422 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2423 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2424 } while (1);
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2425 }
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2426
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 /* Read the next Lisp object from the stream READCHARFUN and return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 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
2429 encountered a misplaced token (e.g. a right bracket, right paren,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 or dot followed by a non-number). To filter this stuff out,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 use read0(). */
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 read1 (Lisp_Object readcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2436 Ichar c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 c = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 switch (c)
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 case '(':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 /* if this is disabled, then other code in eval.c must be enabled */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2447 Ichar ch = reader_nextchar (readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 switch (ch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 case '`':
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 Lisp_Object tem;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2453 int speccount = internal_bind_int (&old_backquote_flag,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2454 1 + old_backquote_flag);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 tem = read0 (readcharfun);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2456 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 if (ch != ')')
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 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2462 list1 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 ("Weird old-backquote syntax")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 return list2 (Qbacktick, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 case ',':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 if (old_backquote_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 Lisp_Object tem, comma_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 ch = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 if (ch == '@')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 comma_type = Qcomma_at;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 if (ch >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 comma_type = Qcomma;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 tem = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 if (ch != ')')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2487 list1 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 ("Weird old-backquote syntax")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 return list2 (comma_type, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2497 list1 (build_msg_string ("Comma outside of backquote")));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 /* #### - yuck....but this is reverse compatible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 /* mostly this is required by edebug, which does its own
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 annotated reading. We need to have an annotated_read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 function that records (with markers) the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 positions of the elements that make up lists, then that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 can be used in edebug and bytecomp and the check above
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 can go back in. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 #endif
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 } /* switch(ch) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 #endif /* old backquote crap... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 return read_list (readcharfun, ')', 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 case '[':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 return read_vector (readcharfun, ']');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 case ')':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 case ']':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 /* #### - huh? these don't do what they seem... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 return noseeum_cons (Qunbound, make_char (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 case '.':
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 /* 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
2526 as a floating point number. Otherwise, it denotes a dotted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 pair.
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 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2532 /* Can't use isdigit on Ichars */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 if (c < '0' || c > '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 return noseeum_cons (Qunbound, make_char ('.'));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 /* Note that read_atom will loop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 at least once, assuring that we will not try to UNREAD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 two characters in a row.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 (I think this doesn't matter anymore because there should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 be no more danger in unreading multiple characters) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 return read_atom (readcharfun, '.', 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 }
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 case '#':
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 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 #if 0 /* FSFmacs silly char-table syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 case '^':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 #if 0 /* FSFmacs silly bool-vector syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 case '&':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 /* "#["-- byte-code constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 /* purecons #[...] syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 case '[': return read_compiled_function (readcharfun, ']'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 /*, purify_flag */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 /* "#:"-- gensym syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 case ':': return read_atom (readcharfun, -1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 /* #'x => (function x) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 case '\'': return list2 (Qfunction, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 /* RMS uses this syntax for fat-strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 If we use it for vectors, then obscure bugs happen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 /* "#(" -- Scheme/CL vector syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 case '(': return read_vector (readcharfun, ')');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 #if 0 /* FSFmacs */
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 Lisp_Object tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 /* Read the string itself. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 tmp = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 if (!STRINGP (tmp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2581 free_cons (tmp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 GCPRO1 (tmp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 /* Read the intervals and their properties. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 Lisp_Object beg, end, plist;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2590 Ichar ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 int invalid = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 beg = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 ch = XCHAR (XCDR (beg));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2597 free_cons (beg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 if (ch == ')')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 if (!invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 end = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 if (CONSP (end) && UNBOUNDP (XCAR (end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2608 free_cons (end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 if (!invalid)
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 plist = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2617 free_cons (plist);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 invalid = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 if (invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 RETURN_UNGCPRO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 (Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 list2
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2625 (build_msg_string ("invalid string property list"),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 XCDR (plist))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 Fset_text_properties (beg, end, plist, tmp);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 return tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 case '@':
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 /* #@NUMBER is used to skip NUMBER following characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 That's used in .elc files to skip over doc strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 and function definitions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 int i, nskip = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 /* Read a decimal integer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 while ((c = readchar (readcharfun)) >= 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 && c >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 nskip = (10 * nskip) + (c - '0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 if (c >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 /* FSF has code here that maybe caches the skipped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 string. See above for why this is totally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 losing. We handle this differently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 /* Skip that many characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 for (i = 0; i < nskip && c >= 0; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 c = readchar (readcharfun);
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 goto retry;
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 case '$': return Vload_file_name_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 /* bit vectors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 case '*': return read_bit_vector (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 /* #o10 => 8 -- octal constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 case 'o': return read_integer (readcharfun, 8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 /* #xdead => 57005 -- hex constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 case 'x': return read_integer (readcharfun, 16);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 /* #b010 => 2 -- binary constant syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 case 'b': return read_integer (readcharfun, 2);
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2666 /* #r"raw\stringt" -- raw string syntax */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2667 case 'r': return read_raw_string(readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 case 's': return read_structure (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 case '<':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 unreadchar (readcharfun, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2674 list1 (build_msg_string ("Cannot read unreadable object")));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 case '+':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 case '-':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 {
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2680 Lisp_Object feature_exp, obj, tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2683 feature_exp = read0(readcharfun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 obj = read0(readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 /* the call to `featurep' may GC. */
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2687 GCPRO2 (feature_exp, obj);
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
2688 tem = call1 (Qfeaturep, feature_exp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 if (c == '+' && NILP(tem)) goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 if (c == '-' && !NILP(tem)) goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 case '0': case '1': case '2': case '3': case '4':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 case '5': case '6': case '7': case '8': case '9':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 /* Reader forms that can reuse previously read objects. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 int n = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 Lisp_Object found;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 /* Using read_integer() here is impossible, because it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 chokes on `='. Using parse_integer() is too hard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 So we simply read it in, and ignore overflows, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 is safe. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 while (c >= '0' && c <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 n *= 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 n += c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 c = readchar (readcharfun);
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 found = assq_no_quit (make_int (n), Vread_objects);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 if (c == '=')
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 /* #n=object returns object, but associates it with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 n for #n#. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 Lisp_Object obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 if (CONSP (found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2721 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 ("Multiply defined symbol label"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 make_int (n)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 obj = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 Vread_objects = Fcons (Fcons (make_int (n), obj),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 Vread_objects);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 else if (c == '#')
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 /* #n# returns a previously read object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 if (CONSP (found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 return XCDR (found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 return Fsignal (Qinvalid_read_syntax,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2736 list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 ("Undefined symbol label"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 make_int (n)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 default:
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, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 return Fsignal (Qinvalid_read_syntax,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 list1 (build_string ("#")));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 /* Quote */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 case '\'': return list2 (Qquote, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 case '`':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 Lisp_Object tem;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2759 int speccount = internal_bind_int (&new_backquote_flag,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2760 1 + new_backquote_flag);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 tem = read0 (readcharfun);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2762 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 return list2 (Qbackquote, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 case ',':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 if (new_backquote_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 Lisp_Object comma_type = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 int ch = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 if (ch == '@')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 comma_type = Qcomma_at;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 else if (ch == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 comma_type = Qcomma_dot;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 else
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 if (ch >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 comma_type = Qcomma;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 return list2 (comma_type, read0 (readcharfun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 else
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 /* YUCK. 99.999% backwards compatibility. The Right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 Thing(tm) is to signal an error here, because it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 really invalid read syntax. Instead, this permits
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 commas to begin symbols (unless they're inside
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 backquotes). If an error is signalled here in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 future, then commas should be invalid read syntax
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 outside of backquotes anywhere they're found (i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 they must be quoted in symbols) -- Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 return read_atom (readcharfun, c, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 #endif
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 case '?':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 /* Evil GNU Emacs "character" (ie integer) syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 c = readchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 if (c < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 if (c == '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 c = read_escape (readcharfun);
4439
f4eb31866c38 Fix reader crash.
Mike Sperber <sperber@deinprogramm.de>
parents: 4329
diff changeset
2809 if (c < 0)
f4eb31866c38 Fix reader crash.
Mike Sperber <sperber@deinprogramm.de>
parents: 4329
diff changeset
2810 return Fsignal (Qinvalid_read_syntax, list1 (READCHARFUN_MAYBE (readcharfun)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 return make_char (c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 case '\"':
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2815 /* String */
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents: 3439
diff changeset
2816 return read_string(readcharfun, '\"', 0, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 /* Ignore whitespace and control characters */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 if (c <= 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 return read_atom (readcharfun, c, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 #define LEAD_INT 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 #define DOT_CHAR 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 #define TRAIL_INT 4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 #define E_CHAR 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 #define EXP_INT 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2837 isfloat_string (const char *cp)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 int state = 0;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2840 const Ibyte *ucp = (const Ibyte *) cp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 if (*ucp == '+' || *ucp == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 if (*ucp >= '0' && *ucp <= '9')
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 state |= LEAD_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 ucp++;
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 if (*ucp == '.')
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 state |= DOT_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 if (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 state |= TRAIL_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 if (*ucp == 'e' || *ucp == 'E')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 state |= E_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 if ((*ucp == '+') || (*ucp == '-'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 ucp++;
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 if (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 state |= EXP_INT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 while (*ucp >= '0' && *ucp <= '9')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 ucp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 || (*ucp == '\r') || (*ucp == '\f'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 || state == (DOT_CHAR|TRAIL_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 || state == (LEAD_INT|E_CHAR|EXP_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2884
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2885 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2886 int
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2887 isratio_string (const char *cp)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2888 {
2010
a9cdbfb4716e [xemacs-hg @ 2004-04-13 15:38:30 by james]
james
parents: 1995
diff changeset
2889 /* Possible minus/plus sign */
a9cdbfb4716e [xemacs-hg @ 2004-04-13 15:38:30 by james]
james
parents: 1995
diff changeset
2890 if (*cp == '-' || *cp == '+')
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2891 cp++;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2892
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2893 /* Numerator */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2894 if (*cp < '0' || *cp > '9')
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2895 return 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2896
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2897 do {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2898 cp++;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2899 } while (*cp >= '0' && *cp <= '9');
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2900
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2901 /* Slash */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2902 if (*cp++ != '/')
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2903 return 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2904
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2905 /* Denominator */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2906 if (*cp < '0' || *cp > '9')
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2907 return 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2908
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2909 do {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2910 cp++;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2911 } while (*cp >= '0' && *cp <= '9');
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2912
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2913 return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2914 *cp == '\r' || *cp == '\f';
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2915 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1849
diff changeset
2916 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 static void *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 sequence_reader (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2920 Ichar terminator,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 void *state,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 void * (*conser) (Lisp_Object readcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 void *state, Charcount len))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 Charcount len;
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 for (len = 0; ; len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2929 Ichar ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 ch = reader_nextchar (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 if (ch == terminator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 return state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 unreadchar (readcharfun, ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 if (ch == ']')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2940 read_syntax_error ("\"]\" in a list");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 else if (ch == ')')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2942 read_syntax_error ("\")\" in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 state = ((conser) (readcharfun, state, len));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 struct read_list_state
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 Lisp_Object head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 int length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 int allow_dotted_lists;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2955 Ichar terminator;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 static void *
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2268
diff changeset
2959 read_list_conser (Lisp_Object readcharfun, void *state, Charcount UNUSED (len))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 struct read_list_state *s = (struct read_list_state *) state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 Lisp_Object elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 elt = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 Lisp_Object tem = elt;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2969 Ichar ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 elt = XCDR (elt);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
2972 free_cons (tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 ch = XCHAR (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 #ifdef FEATUREP_SYNTAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 if (ch == s->terminator) /* deal with #+, #- reader macros */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 unreadchar (readcharfun, s->terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 else if (ch == ']')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2982 read_syntax_error ("']' in a list");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 else if (ch == ')')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2984 read_syntax_error ("')' in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 if (ch != '.')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
2988 signal_error (Qinternal_error, "BUG! Internal reader error", elt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 else if (!s->allow_dotted_lists)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2990 read_syntax_error ("\".\" in a vector");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 if (!NILP (s->tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 XCDR (s->tail) = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 s->head = read0 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 elt = read1 (readcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 ch = XCHAR (XCDR (elt));
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3001 free_cons (elt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 if (ch == s->terminator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 unreadchar (readcharfun, s->terminator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3008 read_syntax_error (". in wrong context");
428
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 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 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
3014 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 Vcurrent_compiled_function_annotation = elt;
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 #endif
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 elt = Fcons (elt, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 if (!NILP (s->tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 XCDR (s->tail) = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 s->head = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 s->tail = elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 s->length++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 return s;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
3034 /* 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
3035 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
3036 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
3037 good reasons)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
3038
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
3039 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
3040 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
3041 (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
3042 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
3043 them in again.)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
3044
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
3045 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
3046 free_list() on the returned list here.
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
3047 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 read_list (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3051 Ichar terminator,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 int allow_dotted_lists,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 int check_for_doc_references)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 struct read_list_state s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 Lisp_Object old_compiled_function_annotation =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 Vcurrent_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 s.head = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 s.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 s.length = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 s.allow_dotted_lists = allow_dotted_lists;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 s.terminator = terminator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 GCPRO2 (s.head, s.tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 /* check now for any doc string references and record them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 for later. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 /* We might be dealing with an imperfect list so don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 use LIST_LOOP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
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 Lisp_Object holding_cons = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 Lisp_Object elem = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 /* elem might be (#$ . INT) ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 holding_cons = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 /* or it might be (quote (#$ . INT)) i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 (quote . ((#$ . INT) . nil)) in the case of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 `autoload' (autoload evaluates its arguments, while
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 `defvar', `defun', etc. don't). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 && CONSP (XCDR (elem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 elem = XCAR (XCDR (elem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 holding_cons = XCDR (XCAR (tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 if (CONSP (holding_cons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 if (purify_flag)
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 if (NILP (Vinternal_doc_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 /* We have not yet called Snarf-documentation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 assume this file is described in the DOC file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 and Snarf-documentation will fill in the right
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 value later. For now, replace the whole list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 with 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 XCAR (holding_cons) = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 /* We have already called Snarf-documentation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 make a relative file name for this file, so it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 can be found properly in the installed Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 directory. We don't use Fexpand_file_name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 because that would make the directory absolute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 XCAR (XCAR (holding_cons)) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 concat2 (build_string ("../lisp/"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 Ffile_name_nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 (Vload_file_name_internal));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 /* Not pure. Just add to Vload_force_doc_string_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 and the string will be filled in properly in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 load_force_doc_string_unwind(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 Vload_force_doc_string_list =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 /* We pass the cons that holds the (#$ . INT) so we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 can modify it in-place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 Fcons (holding_cons, Vload_force_doc_string_list);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 return s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 read_vector (Lisp_Object readcharfun,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3145 Ichar terminator)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 Lisp_Object *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 struct read_list_state s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 s.head = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 s.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 s.length = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 s.allow_dotted_lists = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 GCPRO2 (s.head, s.tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 tem = s.head;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 len = XINT (Flength (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 800
diff changeset
3166 s.head = make_vector (len, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 i < len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 i++, p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3172 Lisp_Object otem = tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 tem = Fcar (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 *p = tem;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3175 tem = XCDR (otem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 free_cons (otem);
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 return s.head;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 static Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3182 read_compiled_function (Lisp_Object readcharfun, Ichar terminator)
428
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 /* Accept compiled functions at read-time so that we don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 have to build them at load-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 Lisp_Object stuff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 int iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 int saw_a_doc_ref = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 /* Note: we tell read_list not to search for doc references
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 because we need to handle the "doc reference" for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 instructions and constants differently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 stuff = read_list (readcharfun, terminator, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 len = XINT (Flength (stuff));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 return
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3200 continuable_read_syntax_error ("#[...] used with wrong number of elements");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 for (iii = 0; CONSP (stuff); iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
3204 Lisp_Object victim = stuff;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 make_byte_code_args[iii] = Fcar (stuff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 if ((purify_flag || load_force_doc_strings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 && CONSP (make_byte_code_args[iii])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 if (purify_flag && iii == COMPILED_DOC_STRING)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 /* same as in read_list(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 if (NILP (Vinternal_doc_file_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 make_byte_code_args[iii] = Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 XCAR (make_byte_code_args[iii]) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 concat2 (build_string ("../lisp/"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 Ffile_name_nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 (Vload_file_name_internal));
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 saw_a_doc_ref = 1;
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 stuff = Fcdr (stuff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 free_cons (victim);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 GCPRO1 (make_byte_code_args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 gcpro1.nvars = len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 ebolify_bytecode_constants (make_byte_code_args[2]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 /* make-byte-code looks at purify_flag, which should have the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 * value as our "read-pure" argument */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 stuff = Fmake_byte_code (len, make_byte_code_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 if (saw_a_doc_ref)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 return stuff;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 init_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 Vvalues = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 load_in_progress = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 Vload_descriptor_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 /* 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
3256 the file name is absolute. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 Vload_path = Fcons (build_string (""), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 /* This used to get initialized in init_lread because all streams
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 got closed when dumping occurs. This is no longer true --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 Vread_buffer_stream is a resizing output stream, and there is no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 reason to close it at dump-time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 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
3266 will initialize it only once, at dump-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 if (NILP (Vread_buffer_stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 Vload_force_doc_string_list = Qnil;
4608
1e3cf11fa27d Make #$ truly read-only for Lisp; check this in the test suite.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4483
diff changeset
3271
1e3cf11fa27d Make #$ truly read-only for Lisp; check this in the test suite.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4483
diff changeset
3272 Vload_file_name_internal = Qnil;
1e3cf11fa27d Make #$ truly read-only for Lisp; check this in the test suite.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4483
diff changeset
3273 Vload_file_name = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 syms_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 DEFSUBR (Fread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 DEFSUBR (Fread_from_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 DEFSUBR (Fload_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 DEFSUBR (Flocate_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 DEFSUBR (Flocate_file_clear_hashing);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 DEFSUBR (Feval_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 DEFSUBR (Feval_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3287 DEFSYMBOL (Qstandard_input);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3288 DEFSYMBOL (Qread_char);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3289 DEFSYMBOL (Qload);
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
3290 DEFSYMBOL (Qload_internal);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3291 DEFSYMBOL (Qfset);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 #ifdef LISP_BACKQUOTES
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3294 DEFSYMBOL (Qbackquote);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 defsymbol (&Qbacktick, "`");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 defsymbol (&Qcomma, ",");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 defsymbol (&Qcomma_at, ",@");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 defsymbol (&Qcomma_dot, ",.");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3301 DEFSYMBOL (Qexists);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3302 DEFSYMBOL (Qreadable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3303 DEFSYMBOL (Qwritable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3304 DEFSYMBOL (Qexecutable);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 structure_type_create (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 the_structure_type_dynarr = Dynarr_new (structure_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 reinit_vars_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 Vread_buffer_stream = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 staticpro_nodump (&Vread_buffer_stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321 vars_of_lread (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 DEFVAR_LISP ("values", &Vvalues /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 List of values of all expressions which were read, evaluated and printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 Order is reverse chronological.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 Stream for read to get input from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 See documentation of `read' for possible values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 Vstandard_input = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334 DEFVAR_LISP ("load-path", &Vload_path /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 *List of directories to search for files to load.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 Each element is a string (directory name) or nil (try default directory).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 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
3339 call `expand-file-name' on them before adding them to this list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 Initialized based on EMACSLOADPATH environment variable, if any,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 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
3343 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
3344 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
3345 directory in which the XEmacs executable resides.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 Vload_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 "*Location of lisp files to be used when dumping ONLY."); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 Non-nil iff inside of `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355
2548
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3356 DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3357 An alist of expressions controlling whether particular files can be loaded.
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3358 Each element looks like (FILENAME EXPR).
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3359 FILENAME should be a full pathname, but without the .el suffix.
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3360 When `load' is run and is about to load the specified file, it evaluates
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3361 the form to determine if the file can be loaded.
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3362 This variable is normally initialized automatically.
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3363 */ );
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3364 Vload_suppress_alist = Qnil;
c4c8a36043be [xemacs-hg @ 2005-02-03 07:11:19 by ben]
ben
parents: 2500
diff changeset
3365
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 An alist of expressions to be evalled when particular files are loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 Each element looks like (FILENAME FORMS...).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 When `load' is run and the file-name argument is FILENAME,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 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
3371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 FILENAME must match exactly! Normally FILENAME is the name of a library,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 with no directory specified, since that is how `load' is normally called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 An error in FORMS does not undo the load,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 but does prevent execution of the rest of the FORMS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 Vafter_load_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 *Whether `load' should check whether the source is newer than the binary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 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
3382 corresponding `.el' is newer, a warning message will be printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 */ );
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1123
diff changeset
3384 load_warn_when_source_newer = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 *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
3388 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
3389 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
3390 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
3391 no warning will be printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 load_warn_when_source_only = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 *Whether `load' should ignore `.elc' files when a suffix is not given.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 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
3398 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 load_ignore_elc_files = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3401 DEFVAR_BOOL ("load-ignore-out-of-date-elc-files",
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3402 &load_ignore_out_of_date_elc_files /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3403 *Whether `load' should ignore out-of-date `.elc' files when no suffix is given.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3404 This is normally used when compiling packages of elisp files that may have
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3405 complex dependencies. Ignoring all elc files with `load-ignore-elc-files'
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3406 would also be safe, but much slower.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3407 */ );
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3408 load_ignore_out_of_date_elc_files = 0;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3409
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3410 DEFVAR_BOOL ("load-always-display-messages",
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3411 &load_always_display_messages /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3412 *Whether `load' should always display loading messages.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3413 If this is true, every file loaded will be shown, regardless of the setting
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3414 of the NOMESSAGE parameter, and even when files are loaded indirectly, e.g.
2857
21e33c0c844b [xemacs-hg @ 2005-07-12 23:26:49 by adrian]
adrian
parents: 2567
diff changeset
3415 due to `require'.
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3416 */ );
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3417 load_always_display_messages = 0;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3418
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3419 DEFVAR_BOOL ("load-show-full-path-in-messages",
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3420 &load_show_full_path_in_messages /*
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3421 *Whether `load' should show the full path in all loading messages.
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3422 */ );
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3423 load_show_full_path_in_messages = 0;
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 1104
diff changeset
3424
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 #ifdef LOADHIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 DEFVAR_LISP ("load-history", &Vload_history /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 Alist mapping source file names to symbols and features.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428 Each alist element is a list that starts with a file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 except for one element (optional) that starts with nil and describes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 definitions evaluated from buffers not visiting files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 The remaining elements of each list are symbols defined as functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 Vload_history = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 Used for internal purposes by `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 Vcurrent_load_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 Full name of file being loaded by `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 Vload_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 Function used by `load' and `eval-region' for reading expressions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 The default is nil, which means use the function `read'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 Vload_read_function = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 Non-nil means `load' should force-load all dynamic doc strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 This is useful when the file being loaded is a temporary copy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 load_force_doc_strings = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 /* See read_escape(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 /* Used to be named `puke-on-fsf-keys' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 &fail_on_bucky_bit_character_escapes /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 Whether `read' should signal an error when it encounters unsupported
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 character escape syntaxes or just read them incorrectly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 fail_on_bucky_bit_character_escapes = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 /* This must be initialized in init_lread otherwise it may start out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 with values saved when the image is dumped. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 staticpro (&Vload_descriptor_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 /* Initialized in init_lread. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 staticpro (&Vload_force_doc_string_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 Vload_file_name_internal = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 staticpro (&Vload_file_name_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 Vcurrent_compiled_function_annotation = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 staticpro (&Vcurrent_compiled_function_annotation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 /* So that early-early stuff will work */
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1275
diff changeset
3486 Ffset (Qload, Qload_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 #ifdef FEATUREP_SYNTAX
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
3489 DEFSYMBOL (Qfeaturep);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
3490 Fprovide (intern ("xemacs"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 #ifdef INFODOCK
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
3492 Fprovide (intern ("infodock"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 #endif /* INFODOCK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 #endif /* FEATUREP_SYNTAX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 #ifdef LISP_BACKQUOTES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 old_backquote_flag = new_backquote_flag = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 Vfile_domain = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 Vread_objects = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 staticpro (&Vread_objects);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 Vlocate_file_hash_table = make_lisp_hash_table (200,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 HASH_TABLE_NON_WEAK,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 HASH_TABLE_EQUAL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 staticpro (&Vlocate_file_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 = Vlocate_file_hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 }