341
|
1 /* Lisp parsing and input streams.
|
64770
|
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
|
|
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
100951
|
4 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
|
341
|
5
|
|
6 This file is part of GNU Emacs.
|
|
7
|
94963
|
8 GNU Emacs is free software: you can redistribute it and/or modify
|
341
|
9 it under the terms of the GNU General Public License as published by
|
94963
|
10 the Free Software Foundation, either version 3 of the License, or
|
|
11 (at your option) any later version.
|
341
|
12
|
|
13 GNU Emacs is distributed in the hope that it will be useful,
|
|
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
16 GNU General Public License for more details.
|
|
17
|
|
18 You should have received a copy of the GNU General Public License
|
94963
|
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
341
|
20
|
|
21
|
7898
|
22 #include <config.h>
|
341
|
23 #include <stdio.h>
|
|
24 #include <sys/types.h>
|
|
25 #include <sys/stat.h>
|
|
26 #include <sys/file.h>
|
8083
|
27 #include <errno.h>
|
83449
ff74a86c2b16
Overhaul and simplify single_kboard API. Allow calls to `recursive-edit' in process filters. Small fixes.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
28 #include <setjmp.h>
|
341
|
29 #include "lisp.h"
|
25787
|
30 #include "intervals.h"
|
341
|
31 #include "buffer.h"
|
88383
|
32 #include "character.h"
|
17038
|
33 #include "charset.h"
|
88886
|
34 #include "coding.h"
|
24412
|
35 #include <epaths.h>
|
341
|
36 #include "commands.h"
|
1591
|
37 #include "keyboard.h"
|
83004
7900111db01c
Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
38 #include "frame.h"
|
2044
|
39 #include "termhooks.h"
|
44222
|
40 #include "coding.h"
|
76624
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
41 #include "blockinput.h"
|
341
|
42
|
14972
|
43 #ifdef MSDOS
|
|
44 #if __DJGPP__ < 2
|
|
45 #include <unistd.h> /* to get X_OK */
|
|
46 #endif
|
|
47 #include "msdos.h"
|
|
48 #endif
|
|
49
|
21799
|
50 #ifdef HAVE_UNISTD_H
|
|
51 #include <unistd.h>
|
|
52 #endif
|
|
53
|
341
|
54 #ifndef X_OK
|
|
55 #define X_OK 01
|
|
56 #endif
|
|
57
|
|
58 #include <math.h>
|
|
59
|
14950
|
60 #ifdef HAVE_SETLOCALE
|
|
61 #include <locale.h>
|
|
62 #endif /* HAVE_SETLOCALE */
|
|
63
|
51398
|
64 #ifdef HAVE_FCNTL_H
|
|
65 #include <fcntl.h>
|
|
66 #endif
|
8596
|
67 #ifndef O_RDONLY
|
|
68 #define O_RDONLY 0
|
|
69 #endif
|
|
70
|
34428
|
71 #ifdef HAVE_FSEEKO
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
72 #define file_offset off_t
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
73 #define file_tell ftello
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
74 #else
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
75 #define file_offset long
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
76 #define file_tell ftell
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
77 #endif
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
78
|
31100
|
79 #ifndef USE_CRT_DLL
|
8083
|
80 extern int errno;
|
31100
|
81 #endif
|
8083
|
82
|
2901
|
83 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
|
341
|
84 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
|
10200
|
85 Lisp_Object Qascii_character, Qload, Qload_file_name;
|
13235
|
86 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
|
16937
|
87 Lisp_Object Qinhibit_file_name_operation;
|
64205
|
88 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
89 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
|
2044
|
90
|
88886
|
91 /* Used instead of Qget_file_char while loading *.elc files compiled
|
|
92 by Emacs 21 or older. */
|
|
93 static Lisp_Object Qget_emacs_mule_file_char;
|
|
94
|
|
95 static Lisp_Object Qload_force_doc_strings;
|
|
96
|
2044
|
97 extern Lisp_Object Qevent_symbol_element_mask;
|
16937
|
98 extern Lisp_Object Qfile_exists_p;
|
341
|
99
|
78501
|
100 /* non-zero if inside `load' */
|
341
|
101 int load_in_progress;
|
|
102
|
13601
|
103 /* Directory in which the sources were found. */
|
|
104 Lisp_Object Vsource_directory;
|
|
105
|
39808
|
106 /* Search path and suffixes for files to be loaded. */
|
69170
|
107 Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
|
341
|
108
|
24817
|
109 /* File name of user's init file. */
|
|
110 Lisp_Object Vuser_init_file;
|
|
111
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
112 /* This is the user-visible association list that maps features to
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
113 lists of defs in their load files. */
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
114 Lisp_Object Vload_history;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
115
|
10200
|
116 /* This is used to build the load history. */
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
117 Lisp_Object Vcurrent_load_list;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
118
|
18665
|
119 /* List of files that were preloaded. */
|
|
120 Lisp_Object Vpreloaded_file_list;
|
|
121
|
10200
|
122 /* Name of file actually being read by `load'. */
|
|
123 Lisp_Object Vload_file_name;
|
|
124
|
11079
|
125 /* Function to use for reading, in `load' and friends. */
|
|
126 Lisp_Object Vload_read_function;
|
|
127
|
16141
|
128 /* The association list of objects read with the #n=object form.
|
|
129 Each member of the list has the form (n . object), and is used to
|
|
130 look up the object for the corresponding #n# construct.
|
|
131 It must be set to nil before all top-level calls to read0. */
|
|
132 Lisp_Object read_objects;
|
|
133
|
12780
|
134 /* Nonzero means load should forcibly load all dynamic doc strings. */
|
|
135 static int load_force_doc_strings;
|
|
136
|
21677
|
137 /* Nonzero means read should convert strings to unibyte. */
|
|
138 static int load_convert_to_unibyte;
|
|
139
|
88886
|
140 /* Nonzero means READCHAR should read bytes one by one (not character)
|
|
141 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
|
|
142 This is set to 1 by read1 temporarily while handling #@NUMBER. */
|
|
143 static int load_each_byte;
|
|
144
|
73800
|
145 /* Function to use for loading an Emacs Lisp source file (not
|
17038
|
146 compiled) instead of readevalloop. */
|
|
147 Lisp_Object Vload_source_file_function;
|
|
148
|
25555
|
149 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
|
|
150 Lisp_Object Vbyte_boolean_vars;
|
|
151
|
45554
|
152 /* Whether or not to add a `read-positions' property to symbols
|
|
153 read. */
|
|
154 Lisp_Object Vread_with_symbol_positions;
|
|
155
|
|
156 /* List of (SYMBOL . POSITION) accumulated so far. */
|
|
157 Lisp_Object Vread_symbol_positions_list;
|
|
158
|
5568
|
159 /* List of descriptors now open for Fload. */
|
|
160 static Lisp_Object load_descriptor_list;
|
|
161
|
12780
|
162 /* File for get_file_char to read from. Use by load. */
|
341
|
163 static FILE *instream;
|
|
164
|
|
165 /* When nonzero, read conses in pure space */
|
|
166 static int read_pure;
|
|
167
|
12780
|
168 /* For use within read-from-string (this reader is non-reentrant!!) */
|
341
|
169 static int read_from_string_index;
|
21724
|
170 static int read_from_string_index_byte;
|
341
|
171 static int read_from_string_limit;
|
11683
|
172
|
45554
|
173 /* Number of characters read in the current call to Fread or
|
|
174 Fread_from_string. */
|
|
175 static int readchar_count;
|
20548
|
176
|
22321
|
177 /* This contains the last string skipped with #@. */
|
12780
|
178 static char *saved_doc_string;
|
|
179 /* Length of buffer allocated in saved_doc_string. */
|
|
180 static int saved_doc_string_size;
|
|
181 /* Length of actual data in saved_doc_string. */
|
|
182 static int saved_doc_string_length;
|
|
183 /* This is the file position that string came from. */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
184 static file_offset saved_doc_string_position;
|
12780
|
185
|
22321
|
186 /* This contains the previous string skipped with #@.
|
|
187 We copy it from saved_doc_string when a new string
|
|
188 is put in saved_doc_string. */
|
|
189 static char *prev_saved_doc_string;
|
|
190 /* Length of buffer allocated in prev_saved_doc_string. */
|
|
191 static int prev_saved_doc_string_size;
|
|
192 /* Length of actual data in prev_saved_doc_string. */
|
|
193 static int prev_saved_doc_string_length;
|
|
194 /* This is the file position that string came from. */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
195 static file_offset prev_saved_doc_string_position;
|
22321
|
196
|
11683
|
197 /* Nonzero means inside a new-style backquote
|
|
198 with no surrounding parentheses.
|
|
199 Fread initializes this to zero, so we need not specbind it
|
|
200 or worry about what happens to it when there is an error. */
|
|
201 static int new_backquote_flag;
|
78617
|
202 static Lisp_Object Vold_style_backquotes, Qold_style_backquotes;
|
31534
|
203
|
|
204 /* A list of file names for files being loaded in Fload. Used to
|
|
205 check for recursive loads. */
|
|
206
|
61623
|
207 static Lisp_Object Vloads_in_progress;
|
31534
|
208
|
31804
|
209 /* Non-zero means load dangerous compiled Lisp files. */
|
|
210
|
|
211 int load_dangerous_libraries;
|
|
212
|
|
213 /* A regular expression used to detect files compiled with Emacs. */
|
|
214
|
|
215 static Lisp_Object Vbytecomp_version_regexp;
|
|
216
|
88886
|
217 static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
|
|
218 Lisp_Object));
|
|
219
|
47847
dd601595b35d
Minor white space fix, just supplement the log for previous change:
Markus Rost <rost@math.uni-bielefeld.de>
diff
changeset
|
220 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
|
31804
|
221 Lisp_Object (*) (), int,
|
61403
|
222 Lisp_Object, Lisp_Object,
|
31804
|
223 Lisp_Object, Lisp_Object));
|
|
224 static Lisp_Object load_unwind P_ ((Lisp_Object));
|
|
225 static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
|
|
226
|
71984
|
227 static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
|
72005
|
228 static void end_of_file_error P_ (()) NO_RETURN;
|
71984
|
229
|
341
|
230
|
88886
|
231 /* Functions that read one byte from the current source READCHARFUN
|
|
232 or unreads one byte. If the integer argument C is -1, it returns
|
|
233 one read byte, or -1 when there's no more byte in the source. If C
|
|
234 is 0 or positive, it unreads C, and the return value is not
|
|
235 interesting. */
|
|
236
|
|
237 static int readbyte_for_lambda P_ ((int, Lisp_Object));
|
|
238 static int readbyte_from_file P_ ((int, Lisp_Object));
|
|
239 static int readbyte_from_string P_ ((int, Lisp_Object));
|
|
240
|
341
|
241 /* Handle unreading and rereading of characters.
|
|
242 Write READCHAR to read a character,
|
17038
|
243 UNREAD(c) to unread c to be read again.
|
|
244
|
88886
|
245 These macros correctly read/unread multibyte characters. */
|
341
|
246
|
91093
|
247 #define READCHAR readchar (readcharfun, NULL)
|
341
|
248 #define UNREAD(c) unreadchar (readcharfun, c)
|
|
249
|
91093
|
250 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
|
|
251 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
|
|
252
|
88886
|
253 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
|
89483
|
254 Qlambda, or a cons, we use this to keep an unread character because
|
|
255 a file stream can't handle multibyte-char unreading. The value -1
|
88886
|
256 means that there's no unread character. */
|
|
257 static int unread_char;
|
|
258
|
341
|
259 static int
|
91093
|
260 readchar (readcharfun, multibyte)
|
341
|
261 Lisp_Object readcharfun;
|
91093
|
262 int *multibyte;
|
341
|
263 {
|
|
264 Lisp_Object tem;
|
25787
|
265 register int c;
|
88886
|
266 int (*readbyte) P_ ((int, Lisp_Object));
|
|
267 unsigned char buf[MAX_MULTIBYTE_LENGTH];
|
|
268 int i, len;
|
|
269 int emacs_mule_encoding = 0;
|
341
|
270
|
91093
|
271 if (multibyte)
|
|
272 *multibyte = 0;
|
341
|
273
|
45554
|
274 readchar_count++;
|
49600
|
275
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
276 if (BUFFERP (readcharfun))
|
341
|
277 {
|
21724
|
278 register struct buffer *inbuffer = XBUFFER (readcharfun);
|
|
279
|
|
280 int pt_byte = BUF_PT_BYTE (inbuffer);
|
22103
|
281
|
21724
|
282 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
|
|
283 return -1;
|
|
284
|
|
285 if (! NILP (inbuffer->enable_multibyte_characters))
|
20548
|
286 {
|
22103
|
287 /* Fetch the character code from the buffer. */
|
21724
|
288 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
|
|
289 BUF_INC_POS (inbuffer, pt_byte);
|
|
290 c = STRING_CHAR (p, pt_byte - orig_pt_byte);
|
91093
|
291 if (multibyte)
|
|
292 *multibyte = 1;
|
20548
|
293 }
|
21724
|
294 else
|
|
295 {
|
|
296 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
|
88886
|
297 if (! ASCII_BYTE_P (c))
|
|
298 c = BYTE8_TO_CHAR (c);
|
21724
|
299 pt_byte++;
|
|
300 }
|
|
301 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
|
|
302
|
|
303 return c;
|
341
|
304 }
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
305 if (MARKERP (readcharfun))
|
341
|
306 {
|
21724
|
307 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
|
|
308
|
|
309 int bytepos = marker_byte_position (readcharfun);
|
22103
|
310
|
21724
|
311 if (bytepos >= BUF_ZV_BYTE (inbuffer))
|
|
312 return -1;
|
|
313
|
|
314 if (! NILP (inbuffer->enable_multibyte_characters))
|
20548
|
315 {
|
22103
|
316 /* Fetch the character code from the buffer. */
|
21724
|
317 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
|
|
318 BUF_INC_POS (inbuffer, bytepos);
|
|
319 c = STRING_CHAR (p, bytepos - orig_bytepos);
|
91093
|
320 if (multibyte)
|
|
321 *multibyte = 1;
|
20548
|
322 }
|
21724
|
323 else
|
|
324 {
|
|
325 c = BUF_FETCH_BYTE (inbuffer, bytepos);
|
88886
|
326 if (! ASCII_BYTE_P (c))
|
|
327 c = BYTE8_TO_CHAR (c);
|
21724
|
328 bytepos++;
|
|
329 }
|
|
330
|
|
331 XMARKER (readcharfun)->bytepos = bytepos;
|
|
332 XMARKER (readcharfun)->charpos++;
|
|
333
|
|
334 return c;
|
341
|
335 }
|
22691
|
336
|
|
337 if (EQ (readcharfun, Qlambda))
|
88886
|
338 {
|
|
339 readbyte = readbyte_for_lambda;
|
|
340 goto read_multibyte;
|
|
341 }
|
22691
|
342
|
341
|
343 if (EQ (readcharfun, Qget_file_char))
|
8083
|
344 {
|
88886
|
345 readbyte = readbyte_from_file;
|
|
346 goto read_multibyte;
|
8083
|
347 }
|
341
|
348
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
349 if (STRINGP (readcharfun))
|
341
|
350 {
|
21724
|
351 if (read_from_string_index >= read_from_string_limit)
|
|
352 c = -1;
|
91093
|
353 else if (STRING_MULTIBYTE (readcharfun))
|
|
354 {
|
|
355 if (multibyte)
|
|
356 *multibyte = 1;
|
|
357 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
|
|
358 read_from_string_index,
|
|
359 read_from_string_index_byte);
|
|
360 }
|
29014
|
361 else
|
91093
|
362 {
|
|
363 c = SREF (readcharfun, read_from_string_index_byte);
|
|
364 read_from_string_index++;
|
|
365 read_from_string_index_byte++;
|
|
366 }
|
341
|
367 return c;
|
|
368 }
|
|
369
|
88886
|
370 if (CONSP (readcharfun))
|
|
371 {
|
|
372 /* This is the case that read_vector is reading from a unibyte
|
|
373 string that contains a byte sequence previously skipped
|
|
374 because of #@NUMBER. The car part of readcharfun is that
|
|
375 string, and the cdr part is a value of readcharfun given to
|
|
376 read_vector. */
|
|
377 readbyte = readbyte_from_string;
|
|
378 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
|
|
379 emacs_mule_encoding = 1;
|
|
380 goto read_multibyte;
|
|
381 }
|
89483
|
382
|
88886
|
383 if (EQ (readcharfun, Qget_emacs_mule_file_char))
|
|
384 {
|
|
385 readbyte = readbyte_from_file;
|
|
386 emacs_mule_encoding = 1;
|
|
387 goto read_multibyte;
|
|
388 }
|
341
|
389
|
|
390 tem = call0 (readcharfun);
|
|
391
|
485
|
392 if (NILP (tem))
|
341
|
393 return -1;
|
|
394 return XINT (tem);
|
88886
|
395
|
|
396 read_multibyte:
|
|
397 if (unread_char >= 0)
|
|
398 {
|
|
399 c = unread_char;
|
|
400 unread_char = -1;
|
|
401 return c;
|
|
402 }
|
|
403 c = (*readbyte) (-1, readcharfun);
|
91093
|
404 if (c < 0 || load_each_byte)
|
|
405 return c;
|
|
406 if (multibyte)
|
|
407 *multibyte = 1;
|
|
408 if (ASCII_BYTE_P (c))
|
88886
|
409 return c;
|
|
410 if (emacs_mule_encoding)
|
|
411 return read_emacs_mule_char (c, readbyte, readcharfun);
|
|
412 i = 0;
|
|
413 buf[i++] = c;
|
|
414 len = BYTES_BY_CHAR_HEAD (c);
|
|
415 while (i < len)
|
|
416 {
|
|
417 c = (*readbyte) (-1, readcharfun);
|
|
418 if (c < 0 || ! TRAILING_CODE_P (c))
|
|
419 {
|
|
420 while (--i > 1)
|
|
421 (*readbyte) (buf[i], readcharfun);
|
|
422 return BYTE8_TO_CHAR (buf[0]);
|
|
423 }
|
|
424 buf[i++] = c;
|
|
425 }
|
|
426 return STRING_CHAR (buf, i);
|
341
|
427 }
|
|
428
|
|
429 /* Unread the character C in the way appropriate for the stream READCHARFUN.
|
|
430 If the stream is a user function, call it with the char as argument. */
|
|
431
|
|
432 static void
|
|
433 unreadchar (readcharfun, c)
|
|
434 Lisp_Object readcharfun;
|
|
435 int c;
|
|
436 {
|
45554
|
437 readchar_count--;
|
6471
|
438 if (c == -1)
|
|
439 /* Don't back up the pointer if we're unreading the end-of-input mark,
|
|
440 since readchar didn't advance it when we read it. */
|
|
441 ;
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
442 else if (BUFFERP (readcharfun))
|
20691
|
443 {
|
21724
|
444 struct buffer *b = XBUFFER (readcharfun);
|
|
445 int bytepos = BUF_PT_BYTE (b);
|
|
446
|
88886
|
447 BUF_PT (b)--;
|
|
448 if (! NILP (b->enable_multibyte_characters))
|
|
449 BUF_DEC_POS (b, bytepos);
|
20691
|
450 else
|
88886
|
451 bytepos--;
|
|
452
|
|
453 BUF_PT_BYTE (b) = bytepos;
|
20691
|
454 }
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
455 else if (MARKERP (readcharfun))
|
20691
|
456 {
|
21724
|
457 struct buffer *b = XMARKER (readcharfun)->buffer;
|
|
458 int bytepos = XMARKER (readcharfun)->bytepos;
|
|
459
|
88886
|
460 XMARKER (readcharfun)->charpos--;
|
|
461 if (! NILP (b->enable_multibyte_characters))
|
|
462 BUF_DEC_POS (b, bytepos);
|
20691
|
463 else
|
88886
|
464 bytepos--;
|
|
465
|
|
466 XMARKER (readcharfun)->bytepos = bytepos;
|
20691
|
467 }
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
468 else if (STRINGP (readcharfun))
|
21724
|
469 {
|
|
470 read_from_string_index--;
|
|
471 read_from_string_index_byte
|
|
472 = string_char_to_byte (readcharfun, read_from_string_index);
|
|
473 }
|
88886
|
474 else if (CONSP (readcharfun))
|
|
475 {
|
|
476 unread_char = c;
|
|
477 }
|
22691
|
478 else if (EQ (readcharfun, Qlambda))
|
88886
|
479 {
|
|
480 unread_char = c;
|
|
481 }
|
|
482 else if (EQ (readcharfun, Qget_file_char)
|
|
483 || EQ (readcharfun, Qget_emacs_mule_file_char))
|
|
484 {
|
|
485 if (load_each_byte)
|
90789
|
486 {
|
|
487 BLOCK_INPUT;
|
|
488 ungetc (c, instream);
|
|
489 UNBLOCK_INPUT;
|
|
490 }
|
88886
|
491 else
|
|
492 unread_char = c;
|
|
493 }
|
341
|
494 else
|
|
495 call1 (readcharfun, make_number (c));
|
|
496 }
|
|
497
|
88886
|
498 static int
|
|
499 readbyte_for_lambda (c, readcharfun)
|
|
500 int c;
|
|
501 Lisp_Object readcharfun;
|
|
502 {
|
|
503 return read_bytecode_char (c >= 0);
|
|
504 }
|
|
505
|
|
506
|
|
507 static int
|
|
508 readbyte_from_file (c, readcharfun)
|
|
509 int c;
|
|
510 Lisp_Object readcharfun;
|
|
511 {
|
|
512 if (c >= 0)
|
76624
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
513 {
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
514 BLOCK_INPUT;
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
515 ungetc (c, instream);
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
516 UNBLOCK_INPUT;
|
88886
|
517 return 0;
|
|
518 }
|
|
519
|
90789
|
520 BLOCK_INPUT;
|
88886
|
521 c = getc (instream);
|
90789
|
522
|
88886
|
523 #ifdef EINTR
|
90789
|
524 /* Interrupted reads have been observed while reading over the network */
|
|
525 while (c == EOF && ferror (instream) && errno == EINTR)
|
|
526 {
|
90796
|
527 UNBLOCK_INPUT;
|
90789
|
528 QUIT;
|
|
529 BLOCK_INPUT;
|
90796
|
530 clearerr (instream);
|
90789
|
531 c = getc (instream);
|
|
532 }
|
88886
|
533 #endif
|
90789
|
534
|
90796
|
535 UNBLOCK_INPUT;
|
|
536
|
88886
|
537 return (c == EOF ? -1 : c);
|
|
538 }
|
|
539
|
|
540 static int
|
|
541 readbyte_from_string (c, readcharfun)
|
|
542 int c;
|
|
543 Lisp_Object readcharfun;
|
|
544 {
|
|
545 Lisp_Object string = XCAR (readcharfun);
|
|
546
|
|
547 if (c >= 0)
|
|
548 {
|
|
549 read_from_string_index--;
|
|
550 read_from_string_index_byte
|
|
551 = string_char_to_byte (string, read_from_string_index);
|
|
552 }
|
89483
|
553
|
88886
|
554 if (read_from_string_index >= read_from_string_limit)
|
|
555 c = -1;
|
|
556 else
|
|
557 FETCH_STRING_CHAR_ADVANCE (c, string,
|
|
558 read_from_string_index,
|
|
559 read_from_string_index_byte);
|
|
560 return c;
|
|
561 }
|
|
562
|
|
563
|
|
564 /* Read one non-ASCII character from INSTREAM. The character is
|
|
565 encoded in `emacs-mule' and the first byte is already read in
|
|
566 C. */
|
|
567
|
|
568 extern char emacs_mule_bytes[256];
|
|
569
|
|
570 static int
|
|
571 read_emacs_mule_char (c, readbyte, readcharfun)
|
|
572 int c;
|
|
573 int (*readbyte) P_ ((int, Lisp_Object));
|
|
574 Lisp_Object readcharfun;
|
|
575 {
|
|
576 /* Emacs-mule coding uses at most 4-byte for one character. */
|
|
577 unsigned char buf[4];
|
|
578 int len = emacs_mule_bytes[c];
|
|
579 struct charset *charset;
|
|
580 int i;
|
|
581 unsigned code;
|
|
582
|
|
583 if (len == 1)
|
|
584 /* C is not a valid leading-code of `emacs-mule'. */
|
|
585 return BYTE8_TO_CHAR (c);
|
|
586
|
|
587 i = 0;
|
|
588 buf[i++] = c;
|
|
589 while (i < len)
|
|
590 {
|
|
591 c = (*readbyte) (-1, readcharfun);
|
|
592 if (c < 0xA0)
|
|
593 {
|
|
594 while (--i > 1)
|
|
595 (*readbyte) (buf[i], readcharfun);
|
|
596 return BYTE8_TO_CHAR (buf[0]);
|
|
597 }
|
|
598 buf[i++] = c;
|
|
599 }
|
|
600
|
|
601 if (len == 2)
|
|
602 {
|
89417
|
603 charset = emacs_mule_charset[buf[0]];
|
88886
|
604 code = buf[1] & 0x7F;
|
|
605 }
|
|
606 else if (len == 3)
|
|
607 {
|
|
608 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
|
|
609 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
|
|
610 {
|
|
611 charset = emacs_mule_charset[buf[1]];
|
|
612 code = buf[2] & 0x7F;
|
|
613 }
|
|
614 else
|
|
615 {
|
|
616 charset = emacs_mule_charset[buf[0]];
|
|
617 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
|
|
618 }
|
76624
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
619 }
|
341
|
620 else
|
88886
|
621 {
|
|
622 charset = emacs_mule_charset[buf[1]];
|
89483
|
623 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
|
88886
|
624 }
|
|
625 c = DECODE_CHAR (charset, code);
|
|
626 if (c < 0)
|
|
627 Fsignal (Qinvalid_read_syntax,
|
|
628 Fcons (build_string ("invalid multibyte form"), Qnil));
|
|
629 return c;
|
341
|
630 }
|
|
631
|
88886
|
632
|
45554
|
633 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
|
|
634 Lisp_Object));
|
|
635 static Lisp_Object read0 P_ ((Lisp_Object));
|
49600
|
636 static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
|
45554
|
637
|
|
638 static Lisp_Object read_list P_ ((int, Lisp_Object));
|
|
639 static Lisp_Object read_vector P_ ((Lisp_Object, int));
|
|
640
|
|
641 static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
|
|
642 Lisp_Object));
|
|
643 static void substitute_object_in_subtree P_ ((Lisp_Object,
|
|
644 Lisp_Object));
|
|
645 static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
|
25165
|
646
|
341
|
647
|
21724
|
648 /* Get a character from the tty. */
|
341
|
649
|
2654
|
650 /* Read input events until we get one that's acceptable for our purposes.
|
|
651
|
|
652 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
|
|
653 until we get a character we like, and then stuffed into
|
|
654 unread_switch_frame.
|
|
655
|
|
656 If ASCII_REQUIRED is non-zero, we check function key events to see
|
|
657 if the unmodified version of the symbol has a Qascii_character
|
|
658 property, and use that character, if present.
|
|
659
|
|
660 If ERROR_NONASCII is non-zero, we signal an error if the input we
|
|
661 get isn't an ASCII character with modifiers. If it's zero but
|
|
662 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
|
23056
|
663 character.
|
|
664
|
|
665 If INPUT_METHOD is nonzero, we invoke the current input method
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
666 if the character warrants that.
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
667
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
668 If SECONDS is a number, we wait that many seconds for input, and
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
669 return Qnil if no input arrives within that time. */
|
14483
|
670
|
2654
|
671 Lisp_Object
|
23056
|
672 read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
673 input_method, seconds)
|
23056
|
674 int no_switch_frame, ascii_required, error_nonascii, input_method;
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
675 Lisp_Object seconds;
|
2654
|
676 {
|
71672
9c4db0e8490f
(read_filtered_event): Remove `register' qualifier because it
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
677 Lisp_Object val, delayed_switch_frame;
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
678 EMACS_TIME end_time;
|
6503
7c566d0e4b3d
(read_filtered_event, intern): Use assignment instead of initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
679
|
28633
|
680 #ifdef HAVE_WINDOW_SYSTEM
|
36256
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
681 if (display_hourglass_p)
|
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
682 cancel_hourglass ();
|
28633
|
683 #endif
|
49600
|
684
|
6503
7c566d0e4b3d
(read_filtered_event, intern): Use assignment instead of initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
685 delayed_switch_frame = Qnil;
|
2654
|
686
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
687 /* Compute timeout. */
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
688 if (NUMBERP (seconds))
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
689 {
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
690 EMACS_TIME wait_time;
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
691 int sec, usec;
|
74566
|
692 double duration = extract_float (seconds);
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
693
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
694 sec = (int) duration;
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
695 usec = (duration - sec) * 1000000;
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
696 EMACS_GET_TIME (end_time);
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
697 EMACS_SET_SECS_USECS (wait_time, sec, usec);
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
698 EMACS_ADD_TIME (end_time, end_time, wait_time);
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
699 }
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
700
|
83533
|
701 /* Read until we get an acceptable event. */
|
2654
|
702 retry:
|
85000
|
703 do
|
83533
|
704 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
|
|
705 NUMBERP (seconds) ? &end_time : NULL);
|
83460
|
706 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
|
2654
|
707
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
708 if (BUFFERP (val))
|
5888
|
709 goto retry;
|
|
710
|
2654
|
711 /* switch-frame events are put off until after the next ASCII
|
14036
|
712 character. This is better than signaling an error just because
|
2654
|
713 the last characters were typed to a separate minibuffer frame,
|
|
714 for example. Eventually, some code which can deal with
|
|
715 switch-frame events will read it and process it. */
|
|
716 if (no_switch_frame
|
|
717 && EVENT_HAS_PARAMETERS (val)
|
71558
4252d6e24270
(read_filtered_event): Treat select-window just like switch-frame.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
718 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
|
2654
|
719 {
|
|
720 delayed_switch_frame = val;
|
|
721 goto retry;
|
|
722 }
|
|
723
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
724 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
|
2654
|
725 {
|
|
726 /* Convert certain symbols to their ASCII equivalents. */
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
727 if (SYMBOLP (val))
|
2654
|
728 {
|
25787
|
729 Lisp_Object tem, tem1;
|
2654
|
730 tem = Fget (val, Qevent_symbol_element_mask);
|
|
731 if (!NILP (tem))
|
|
732 {
|
|
733 tem1 = Fget (Fcar (tem), Qascii_character);
|
|
734 /* Merge this symbol's modifier bits
|
|
735 with the ASCII equivalent of its basic code. */
|
|
736 if (!NILP (tem1))
|
9313
|
737 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
|
2654
|
738 }
|
|
739 }
|
49600
|
740
|
2654
|
741 /* If we don't have a character now, deal with it appropriately. */
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
742 if (!INTEGERP (val))
|
2654
|
743 {
|
|
744 if (error_nonascii)
|
|
745 {
|
7106
|
746 Vunread_command_events = Fcons (val, Qnil);
|
2654
|
747 error ("Non-character input-event");
|
|
748 }
|
|
749 else
|
|
750 goto retry;
|
|
751 }
|
|
752 }
|
|
753
|
|
754 if (! NILP (delayed_switch_frame))
|
|
755 unread_switch_frame = delayed_switch_frame;
|
|
756
|
43700
2388863b284b
(read_filtered_event): Do not call start_hourglass before returning.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
757 #if 0
|
2388863b284b
(read_filtered_event): Do not call start_hourglass before returning.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
758
|
28633
|
759 #ifdef HAVE_WINDOW_SYSTEM
|
36256
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
760 if (display_hourglass_p)
|
e033d60bd048
Use display_hourglass_p, start_hourglass, cancel_hourglass instead of
Gerd Moellmann <gerd@gnu.org>
diff
changeset
|
761 start_hourglass ();
|
28633
|
762 #endif
|
43700
2388863b284b
(read_filtered_event): Do not call start_hourglass before returning.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
763
|
2388863b284b
(read_filtered_event): Do not call start_hourglass before returning.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
764 #endif
|
2388863b284b
(read_filtered_event): Do not call start_hourglass before returning.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
765
|
2654
|
766 return val;
|
|
767 }
|
|
768
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
769 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
770 doc: /* Read a character from the command input (keyboard or macro).
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
771 It is returned as a number.
|
92497
|
772 If the character has modifiers, they are resolved and reflected to the
|
|
773 character code if possible (e.g. C-SPC -> 0).
|
|
774
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
775 If the user generates an event which is not a character (i.e. a mouse
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
776 click or function key event), `read-char' signals an error. As an
|
92497
|
777 exception, switch-frame events are put off until non-character events
|
|
778 can be read.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
779 If you want to read non-character events, or ignore them, call
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
780 `read-event' or `read-char-exclusive' instead.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
781
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
782 If the optional argument PROMPT is non-nil, display that as a prompt.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
783 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
784 input method is turned on in the current buffer, that input method
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
785 is used for reading a character.
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
786 If the optional argument SECONDS is non-nil, it should be a number
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
787 specifying the maximum number of seconds to wait for input. If no
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
788 input arrives in that time, return nil. SECONDS may be a
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
789 floating-point value. */)
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
790 (prompt, inherit_input_method, seconds)
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
791 Lisp_Object prompt, inherit_input_method, seconds;
|
341
|
792 {
|
92497
|
793 Lisp_Object val;
|
|
794
|
23056
|
795 if (! NILP (prompt))
|
|
796 message_with_string ("%s", prompt, 0);
|
92497
|
797 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
|
97470
9a4bddae759e
(Fread_char, Fread_char_exclusive): If no character event is read
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
798
|
9a4bddae759e
(Fread_char, Fread_char_exclusive): If no character event is read
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
799 return (NILP (val) ? Qnil
|
9a4bddae759e
(Fread_char, Fread_char_exclusive): If no character event is read
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
800 : make_number (char_resolve_modifier_mask (XINT (val))));
|
341
|
801 }
|
|
802
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
803 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
804 doc: /* Read an event object from the input stream.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
805 If the optional argument PROMPT is non-nil, display that as a prompt.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
806 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
807 input method is turned on in the current buffer, that input method
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
808 is used for reading a character.
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
809 If the optional argument SECONDS is non-nil, it should be a number
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
810 specifying the maximum number of seconds to wait for input. If no
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
811 input arrives in that time, return nil. SECONDS may be a
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
812 floating-point value. */)
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
813 (prompt, inherit_input_method, seconds)
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
814 Lisp_Object prompt, inherit_input_method, seconds;
|
23056
|
815 {
|
|
816 if (! NILP (prompt))
|
|
817 message_with_string ("%s", prompt, 0);
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
818 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
|
23056
|
819 }
|
|
820
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
821 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
822 doc: /* Read a character from the command input (keyboard or macro).
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
823 It is returned as a number. Non-character events are ignored.
|
92497
|
824 If the character has modifiers, they are resolved and reflected to the
|
|
825 character code if possible (e.g. C-SPC -> 0).
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
826
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
827 If the optional argument PROMPT is non-nil, display that as a prompt.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
828 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
829 input method is turned on in the current buffer, that input method
|
72132
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
830 is used for reading a character.
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
831 If the optional argument SECONDS is non-nil, it should be a number
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
832 specifying the maximum number of seconds to wait for input. If no
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
833 input arrives in that time, return nil. SECONDS may be a
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
834 floating-point value. */)
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
835 (prompt, inherit_input_method, seconds)
|
9ac2eb12b7f1
* lread.c (read_filtered_event): New arg SECONDS to wait until.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
836 Lisp_Object prompt, inherit_input_method, seconds;
|
341
|
837 {
|
92497
|
838 Lisp_Object val;
|
|
839
|
23056
|
840 if (! NILP (prompt))
|
|
841 message_with_string ("%s", prompt, 0);
|
97470
9a4bddae759e
(Fread_char, Fread_char_exclusive): If no character event is read
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
842
|
92497
|
843 val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
|
97470
9a4bddae759e
(Fread_char, Fread_char_exclusive): If no character event is read
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
844
|
9a4bddae759e
(Fread_char, Fread_char_exclusive): If no character event is read
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
845 return (NILP (val) ? Qnil
|
9a4bddae759e
(Fread_char, Fread_char_exclusive): If no character event is read
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
846 : make_number (char_resolve_modifier_mask (XINT (val))));
|
341
|
847 }
|
|
848
|
|
849 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
850 doc: /* Don't use this yourself. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
851 ()
|
341
|
852 {
|
|
853 register Lisp_Object val;
|
76624
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
854 BLOCK_INPUT;
|
9274
5c66d8b65a7c
(Fget_file_char, Fload, read1, oblookup, map_obarray, defsubr, defalias,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
855 XSETINT (val, getc (instream));
|
76624
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
856 UNBLOCK_INPUT;
|
341
|
857 return val;
|
|
858 }
|
31804
|
859
|
|
860
|
341
|
861
|
88886
|
862 /* Value is a version number of byte compiled code if the file
|
91041
|
863 associated with file descriptor FD is a compiled Lisp file that's
|
88886
|
864 safe to load. Only files compiled with Emacs are safe to load.
|
|
865 Files compiled with XEmacs can lead to a crash in Fbyte_code
|
|
866 because of an incompatible change in the byte compiler. */
|
28156
|
867
|
|
868 static int
|
|
869 safe_to_load_p (fd)
|
|
870 int fd;
|
|
871 {
|
|
872 char buf[512];
|
|
873 int nbytes, i;
|
|
874 int safe_p = 1;
|
89483
|
875 int version = 1;
|
28156
|
876
|
|
877 /* Read the first few bytes from the file, and look for a line
|
|
878 specifying the byte compiler version used. */
|
|
879 nbytes = emacs_read (fd, buf, sizeof buf - 1);
|
|
880 if (nbytes > 0)
|
|
881 {
|
|
882 buf[nbytes] = '\0';
|
|
883
|
|
884 /* Skip to the next newline, skipping over the initial `ELC'
|
88774
|
885 with NUL bytes following it, but note the version. */
|
28156
|
886 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
|
88774
|
887 if (i == 4)
|
88886
|
888 version = buf[i];
|
28156
|
889
|
89012
|
890 if (i == nbytes
|
|
891 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
|
28156
|
892 buf + i) < 0)
|
|
893 safe_p = 0;
|
|
894 }
|
88774
|
895 if (safe_p)
|
|
896 safe_p = version;
|
28156
|
897
|
|
898 lseek (fd, 0, SEEK_SET);
|
|
899 return safe_p;
|
|
900 }
|
|
901
|
|
902
|
31534
|
903 /* Callback for record_unwind_protect. Restore the old load list OLD,
|
|
904 after loading a file successfully. */
|
|
905
|
|
906 static Lisp_Object
|
|
907 record_load_unwind (old)
|
|
908 Lisp_Object old;
|
|
909 {
|
|
910 return Vloads_in_progress = old;
|
|
911 }
|
|
912
|
48910
|
913 /* This handler function is used via internal_condition_case_1. */
|
|
914
|
|
915 static Lisp_Object
|
|
916 load_error_handler (data)
|
|
917 Lisp_Object data;
|
|
918 {
|
|
919 return Qnil;
|
|
920 }
|
31534
|
921
|
78617
|
922 static Lisp_Object
|
|
923 load_warn_old_style_backquotes (file)
|
|
924 Lisp_Object file;
|
|
925 {
|
|
926 if (!NILP (Vold_style_backquotes))
|
|
927 {
|
78628
29320ef98233
(load_warn_old_style_backquotes): Fix up array size typo.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
928 Lisp_Object args[2];
|
84465
bf23b0b54ed3
(load_warn_old_style_backquotes): Change message to look
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
929 args[0] = build_string ("Loading `%s': old-style backquotes detected!");
|
78617
|
930 args[1] = file;
|
|
931 Fmessage (2, args);
|
|
932 }
|
|
933 return Qnil;
|
|
934 }
|
|
935
|
69170
|
936 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
|
|
937 doc: /* Return the suffixes that `load' should try if a suffix is \
|
|
938 required.
|
|
939 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
|
|
940 ()
|
|
941 {
|
|
942 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
|
|
943 while (CONSP (suffixes))
|
|
944 {
|
|
945 Lisp_Object exts = Vload_file_rep_suffixes;
|
|
946 suffix = XCAR (suffixes);
|
|
947 suffixes = XCDR (suffixes);
|
|
948 while (CONSP (exts))
|
|
949 {
|
|
950 ext = XCAR (exts);
|
|
951 exts = XCDR (exts);
|
|
952 lst = Fcons (concat2 (suffix, ext), lst);
|
|
953 }
|
|
954 }
|
|
955 return Fnreverse (lst);
|
|
956 }
|
|
957
|
19115
|
958 DEFUN ("load", Fload, Sload, 1, 5, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
959 doc: /* Execute a file of Lisp code named FILE.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
960 First try FILE with `.elc' appended, then try with `.el',
|
69170
|
961 then try FILE unmodified (the exact suffixes in the exact order are
|
78928
|
962 determined by `load-suffixes'). Environment variable references in
|
69170
|
963 FILE are replaced with their values by calling `substitute-in-file-name'.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
964 This function searches the directories in `load-path'.
|
69170
|
965
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
966 If optional second arg NOERROR is non-nil,
|
69170
|
967 report no error if FILE doesn't exist.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
968 Print messages at start and end of loading unless
|
69170
|
969 optional third arg NOMESSAGE is non-nil.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
970 If optional fourth arg NOSUFFIX is non-nil, don't try adding
|
69170
|
971 suffixes `.elc' or `.el' to the specified name FILE.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
972 If optional fifth arg MUST-SUFFIX is non-nil, insist on
|
69170
|
973 the suffix `.elc' or `.el'; don't accept just FILE unless
|
|
974 it ends in one of those suffixes or includes a directory name.
|
|
975
|
|
976 If this function fails to find a file, it may look for different
|
|
977 representations of that file before trying another file.
|
|
978 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
|
|
979 to the file name. Emacs uses this feature mainly to find compressed
|
|
980 versions of files when Auto Compression mode is enabled.
|
|
981
|
|
982 The exact suffixes that this function tries out, in the exact order,
|
|
983 are given by the value of the variable `load-file-rep-suffixes' if
|
|
984 NOSUFFIX is non-nil and by the return value of the function
|
|
985 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
|
|
986 MUST-SUFFIX are nil, this function first tries out the latter suffixes
|
|
987 and then the former.
|
66284
|
988
|
|
989 Loading a file records its definitions, and its `provide' and
|
|
990 `require' calls, in an element of `load-history' whose
|
|
991 car is the file name loaded. See `load-history'.
|
|
992
|
69170
|
993 Return t if the file exists and loads successfully. */)
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
994 (file, noerror, nomessage, nosuffix, must_suffix)
|
19115
|
995 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
|
341
|
996 {
|
|
997 register FILE *stream;
|
|
998 register int fd = -1;
|
46293
|
999 int count = SPECPDL_INDEX ();
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1000 struct gcpro gcpro1, gcpro2, gcpro3;
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1001 Lisp_Object found, efound, hist_file_name;
|
16012
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1002 /* 1 means we printed the ".el is newer" message. */
|
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1003 int newer = 0;
|
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1004 /* 1 means we are loading a compiled file. */
|
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1005 int compiled = 0;
|
3625
|
1006 Lisp_Object handler;
|
28370
|
1007 int safe_p = 1;
|
21936
|
1008 char *fmode = "r";
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1009 Lisp_Object tmp[2];
|
88886
|
1010 int version;
|
|
1011
|
9790
|
1012 #ifdef DOS_NT
|
21936
|
1013 fmode = "rt";
|
9790
|
1014 #endif /* DOS_NT */
|
341
|
1015
|
40656
|
1016 CHECK_STRING (file);
|
341
|
1017
|
3625
|
1018 /* If file name is magic, call the handler. */
|
39808
|
1019 /* This shouldn't be necessary any more now that `openp' handles it right.
|
|
1020 handler = Ffind_file_name_handler (file, Qload);
|
|
1021 if (!NILP (handler))
|
|
1022 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
|
3625
|
1023
|
10014
|
1024 /* Do this after the handler to avoid
|
|
1025 the need to gcpro noerror, nomessage and nosuffix.
|
39808
|
1026 (Below here, we care only whether they are nil or not.)
|
|
1027 The presence of this call is the result of a historical accident:
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1028 it used to be in every file-operation and when it got removed
|
39808
|
1029 everywhere, it accidentally stayed here. Since then, enough people
|
|
1030 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
|
|
1031 that it seemed risky to remove. */
|
48910
|
1032 if (! NILP (noerror))
|
|
1033 {
|
|
1034 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
|
|
1035 Qt, load_error_handler);
|
|
1036 if (NILP (file))
|
|
1037 return Qnil;
|
|
1038 }
|
|
1039 else
|
|
1040 file = Fsubstitute_in_file_name (file);
|
49600
|
1041
|
10014
|
1042
|
341
|
1043 /* Avoid weird lossage with null string as arg,
|
|
1044 since it would try to load a directory as a Lisp file */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1045 if (SCHARS (file) > 0)
|
341
|
1046 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1047 int size = SBYTES (file);
|
19622
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1048
|
66284
|
1049 found = Qnil;
|
|
1050 GCPRO2 (file, found);
|
19622
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1051
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1052 if (! NILP (must_suffix))
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1053 {
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1054 /* Don't insist on adding a suffix if FILE already ends with one. */
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1055 if (size > 3
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1056 && !strcmp (SDATA (file) + size - 3, ".el"))
|
19622
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1057 must_suffix = Qnil;
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1058 else if (size > 4
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1059 && !strcmp (SDATA (file) + size - 4, ".elc"))
|
19622
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1060 must_suffix = Qnil;
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1061 /* Don't insist on adding a suffix
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1062 if the argument includes a directory name. */
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1063 else if (! NILP (Ffile_name_directory (file)))
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1064 must_suffix = Qnil;
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1065 }
|
be0876941b71
(Fload): If FILE arg ends in .el or .elc, don't insist on adding a suffix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1066
|
19115
|
1067 fd = openp (Vload_path, file,
|
39808
|
1068 (!NILP (nosuffix) ? Qnil
|
69170
|
1069 : !NILP (must_suffix) ? Fget_load_suffixes ()
|
|
1070 : Fappend (2, (tmp[0] = Fget_load_suffixes (),
|
|
1071 tmp[1] = Vload_file_rep_suffixes,
|
39808
|
1072 tmp))),
|
45001
|
1073 &found, Qnil);
|
6392
|
1074 UNGCPRO;
|
341
|
1075 }
|
|
1076
|
33442
|
1077 if (fd == -1)
|
341
|
1078 {
|
485
|
1079 if (NILP (noerror))
|
71984
|
1080 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
|
|
1081 return Qnil;
|
341
|
1082 }
|
|
1083
|
29122
|
1084 /* Tell startup.el whether or not we found the user's init file. */
|
24817
|
1085 if (EQ (Qt, Vuser_init_file))
|
|
1086 Vuser_init_file = found;
|
|
1087
|
33442
|
1088 /* If FD is -2, that means openp found a magic file. */
|
|
1089 if (fd == -2)
|
16937
|
1090 {
|
23193
|
1091 if (NILP (Fequal (found, file)))
|
|
1092 /* If FOUND is a different file name from FILE,
|
|
1093 find its handler even if we have already inhibited
|
|
1094 the `load' operation on FILE. */
|
|
1095 handler = Ffind_file_name_handler (found, Qt);
|
|
1096 else
|
|
1097 handler = Ffind_file_name_handler (found, Qload);
|
|
1098 if (! NILP (handler))
|
|
1099 return call5 (handler, Qload, found, noerror, nomessage, Qt);
|
16937
|
1100 }
|
|
1101
|
31804
|
1102 /* Check if we're stuck in a recursive load cycle.
|
|
1103
|
|
1104 2000-09-21: It's not possible to just check for the file loaded
|
|
1105 being a member of Vloads_in_progress. This fails because of the
|
|
1106 way the byte compiler currently works; `provide's are not
|
98090
|
1107 evaluated, see font-lock.el/jit-lock.el as an example. This
|
31804
|
1108 leads to a certain amount of ``normal'' recursion.
|
|
1109
|
|
1110 Also, just loading a file recursively is not always an error in
|
|
1111 the general case; the second load may do something different. */
|
41463
|
1112 {
|
|
1113 int count = 0;
|
|
1114 Lisp_Object tem;
|
|
1115 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
|
|
1116 if (!NILP (Fequal (found, XCAR (tem))))
|
|
1117 count++;
|
|
1118 if (count > 3)
|
68301
581e383fb47c
(Fload): Don't leak the file descriptor returned by openp if we are going
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1119 {
|
581e383fb47c
(Fload): Don't leak the file descriptor returned by openp if we are going
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1120 if (fd >= 0)
|
581e383fb47c
(Fload): Don't leak the file descriptor returned by openp if we are going
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1121 emacs_close (fd);
|
71984
|
1122 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
|
68301
581e383fb47c
(Fload): Don't leak the file descriptor returned by openp if we are going
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1123 }
|
41463
|
1124 record_unwind_protect (record_load_unwind, Vloads_in_progress);
|
|
1125 Vloads_in_progress = Fcons (found, Vloads_in_progress);
|
|
1126 }
|
31534
|
1127
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1128 /* Get the name for load-history. */
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1129 hist_file_name = (! NILP (Vpurify_flag)
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1130 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1131 tmp[1] = Ffile_name_nondirectory (found),
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1132 tmp))
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1133 : found) ;
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1134
|
88886
|
1135 version = -1;
|
91015
|
1136
|
78928
|
1137 /* Check for the presence of old-style quotes and warn about them. */
|
78617
|
1138 specbind (Qold_style_backquotes, Qnil);
|
|
1139 record_unwind_protect (load_warn_old_style_backquotes, file);
|
|
1140
|
46429
|
1141 if (!bcmp (SDATA (found) + SBYTES (found) - 4,
|
88886
|
1142 ".elc", 4)
|
|
1143 || (version = safe_to_load_p (fd)) > 0)
|
33442
|
1144 /* Load .elc files directly, but not when they are
|
|
1145 remote and have no handler! */
|
341
|
1146 {
|
33442
|
1147 if (fd != -2)
|
28156
|
1148 {
|
33442
|
1149 struct stat s1, s2;
|
|
1150 int result;
|
|
1151
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1152 GCPRO3 (file, found, hist_file_name);
|
66284
|
1153
|
88886
|
1154 if (version < 0
|
|
1155 && ! (version = safe_to_load_p (fd)))
|
33442
|
1156 {
|
|
1157 safe_p = 0;
|
|
1158 if (!load_dangerous_libraries)
|
48087
|
1159 {
|
|
1160 if (fd >= 0)
|
|
1161 emacs_close (fd);
|
|
1162 error ("File `%s' was not compiled in Emacs",
|
|
1163 SDATA (found));
|
|
1164 }
|
33442
|
1165 else if (!NILP (nomessage))
|
|
1166 message_with_string ("File `%s' not compiled in Emacs", found, 1);
|
|
1167 }
|
|
1168
|
|
1169 compiled = 1;
|
|
1170
|
44222
|
1171 efound = ENCODE_FILE (found);
|
|
1172
|
33570
|
1173 #ifdef DOS_NT
|
33442
|
1174 fmode = "rb";
|
33570
|
1175 #endif /* DOS_NT */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1176 stat ((char *)SDATA (efound), &s1);
|
46429
|
1177 SSET (efound, SBYTES (efound) - 1, 0);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1178 result = stat ((char *)SDATA (efound), &s2);
|
46429
|
1179 SSET (efound, SBYTES (efound) - 1, 'c');
|
44222
|
1180
|
33442
|
1181 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
|
|
1182 {
|
|
1183 /* Make the progress messages mention that source is newer. */
|
|
1184 newer = 1;
|
|
1185
|
|
1186 /* If we won't print another message, mention this anyway. */
|
43837
|
1187 if (!NILP (nomessage))
|
|
1188 {
|
66284
|
1189 Lisp_Object msg_file;
|
|
1190 msg_file = Fsubstring (found, make_number (0), make_number (-1));
|
43837
|
1191 message_with_string ("Source file `%s' newer than byte-compiled file",
|
66284
|
1192 msg_file, 1);
|
43837
|
1193 }
|
33442
|
1194 }
|
66284
|
1195 UNGCPRO;
|
28156
|
1196 }
|
341
|
1197 }
|
17038
|
1198 else
|
|
1199 {
|
|
1200 /* We are loading a source file (*.el). */
|
|
1201 if (!NILP (Vload_source_file_function))
|
|
1202 {
|
31534
|
1203 Lisp_Object val;
|
33442
|
1204
|
|
1205 if (fd >= 0)
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1206 emacs_close (fd);
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1207 val = call4 (Vload_source_file_function, found, hist_file_name,
|
31534
|
1208 NILP (noerror) ? Qnil : Qt,
|
|
1209 NILP (nomessage) ? Qnil : Qt);
|
|
1210 return unbind_to (count, val);
|
17038
|
1211 }
|
|
1212 }
|
341
|
1213
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1214 GCPRO3 (file, found, hist_file_name);
|
66284
|
1215
|
21936
|
1216 #ifdef WINDOWSNT
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1217 emacs_close (fd);
|
44222
|
1218 efound = ENCODE_FILE (found);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1219 stream = fopen ((char *) SDATA (efound), fmode);
|
21936
|
1220 #else /* not WINDOWSNT */
|
|
1221 stream = fdopen (fd, fmode);
|
|
1222 #endif /* not WINDOWSNT */
|
341
|
1223 if (stream == 0)
|
|
1224 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1225 emacs_close (fd);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1226 error ("Failure to create stdio stream for %s", SDATA (file));
|
341
|
1227 }
|
|
1228
|
18665
|
1229 if (! NILP (Vpurify_flag))
|
|
1230 Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
|
|
1231
|
16012
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1232 if (NILP (nomessage))
|
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1233 {
|
28156
|
1234 if (!safe_p)
|
|
1235 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
|
|
1236 file, 1);
|
|
1237 else if (!compiled)
|
20609
|
1238 message_with_string ("Loading %s (source)...", file, 1);
|
20168
|
1239 else if (newer)
|
20609
|
1240 message_with_string ("Loading %s (compiled; note, source file is newer)...",
|
|
1241 file, 1);
|
20168
|
1242 else /* The typical case; compiled file newer than source file. */
|
20609
|
1243 message_with_string ("Loading %s...", file, 1);
|
16012
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1244 }
|
341
|
1245
|
64533
|
1246 record_unwind_protect (load_unwind, make_save_value (stream, 0));
|
5568
|
1247 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
|
10200
|
1248 specbind (Qload_file_name, found);
|
16937
|
1249 specbind (Qinhibit_file_name_operation, Qnil);
|
5568
|
1250 load_descriptor_list
|
|
1251 = Fcons (make_number (fileno (stream)), load_descriptor_list);
|
341
|
1252 load_in_progress++;
|
88888
|
1253 if (! version || version >= 22)
|
90428
|
1254 readevalloop (Qget_file_char, stream, hist_file_name,
|
90260
|
1255 Feval, 0, Qnil, Qnil, Qnil, Qnil);
|
88886
|
1256 else
|
|
1257 {
|
|
1258 /* We can't handle a file which was compiled with
|
|
1259 byte-compile-dynamic by older version of Emacs. */
|
|
1260 specbind (Qload_force_doc_strings, Qt);
|
90428
|
1261 readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
|
90140
|
1262 0, Qnil, Qnil, Qnil, Qnil);
|
88886
|
1263 }
|
341
|
1264 unbind_to (count, Qnil);
|
|
1265
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1266 /* Run any eval-after-load forms for this file */
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1267 if (NILP (Vpurify_flag)
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1268 && (!NILP (Ffboundp (Qdo_after_load_evaluation))))
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1269 call1 (Qdo_after_load_evaluation, hist_file_name) ;
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1270
|
341
|
1271 UNGCPRO;
|
|
1272
|
95860
|
1273 xfree (saved_doc_string);
|
12780
|
1274 saved_doc_string = 0;
|
|
1275 saved_doc_string_size = 0;
|
|
1276
|
95481
|
1277 xfree (prev_saved_doc_string);
|
22321
|
1278 prev_saved_doc_string = 0;
|
|
1279 prev_saved_doc_string_size = 0;
|
|
1280
|
485
|
1281 if (!noninteractive && NILP (nomessage))
|
16012
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1282 {
|
28156
|
1283 if (!safe_p)
|
|
1284 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
|
|
1285 file, 1);
|
|
1286 else if (!compiled)
|
20609
|
1287 message_with_string ("Loading %s (source)...done", file, 1);
|
20168
|
1288 else if (newer)
|
20609
|
1289 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
|
|
1290 file, 1);
|
20168
|
1291 else /* The typical case; compiled file newer than source file. */
|
20609
|
1292 message_with_string ("Loading %s...done", file, 1);
|
16012
3b5ffd35defe
(Fload): Add "source is newer" info to the "loading" and "done" messages.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1293 }
|
31534
|
1294
|
51066
|
1295 if (!NILP (Fequal (build_string ("obsolete"),
|
|
1296 Ffile_name_nondirectory
|
|
1297 (Fdirectory_file_name (Ffile_name_directory (found))))))
|
|
1298 message_with_string ("Package %s is obsolete", file, 1);
|
|
1299
|
341
|
1300 return Qt;
|
|
1301 }
|
|
1302
|
|
1303 static Lisp_Object
|
64536
|
1304 load_unwind (arg) /* used as unwind-protect function in load */
|
|
1305 Lisp_Object arg;
|
341
|
1306 {
|
64536
|
1307 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
|
|
1308 if (stream != NULL)
|
76624
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1309 {
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1310 BLOCK_INPUT;
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1311 fclose (stream);
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1312 UNBLOCK_INPUT;
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1313 }
|
341
|
1314 if (--load_in_progress < 0) load_in_progress = 0;
|
|
1315 return Qnil;
|
|
1316 }
|
|
1317
|
5568
|
1318 static Lisp_Object
|
|
1319 load_descriptor_unwind (oldlist)
|
|
1320 Lisp_Object oldlist;
|
|
1321 {
|
|
1322 load_descriptor_list = oldlist;
|
9361
|
1323 return Qnil;
|
5568
|
1324 }
|
|
1325
|
|
1326 /* Close all descriptors in use for Floads.
|
|
1327 This is used when starting a subprocess. */
|
|
1328
|
|
1329 void
|
|
1330 close_load_descs ()
|
|
1331 {
|
15091
|
1332 #ifndef WINDOWSNT
|
5568
|
1333 Lisp_Object tail;
|
85330
|
1334 for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1335 emacs_close (XFASTINT (XCAR (tail)));
|
15091
|
1336 #endif
|
5568
|
1337 }
|
341
|
1338
|
|
1339 static int
|
|
1340 complete_filename_p (pathname)
|
|
1341 Lisp_Object pathname;
|
|
1342 {
|
46472
|
1343 register const unsigned char *s = SDATA (pathname);
|
9790
|
1344 return (IS_DIRECTORY_SEP (s[0])
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1345 || (SCHARS (pathname) > 2
|
97142
|
1346 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
|
341
|
1347 }
|
|
1348
|
45001
|
1349 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
|
|
1350 doc: /* Search for FILENAME through PATH.
|
62116
|
1351 Returns the file's name in absolute form, or nil if not found.
|
45001
|
1352 If SUFFIXES is non-nil, it should be a list of suffixes to append to
|
|
1353 file name when searching.
|
|
1354 If non-nil, PREDICATE is used instead of `file-readable-p'.
|
|
1355 PREDICATE can also be an integer to pass to the access(2) function,
|
|
1356 in which case file-name-handlers are ignored. */)
|
|
1357 (filename, path, suffixes, predicate)
|
|
1358 Lisp_Object filename, path, suffixes, predicate;
|
|
1359 {
|
|
1360 Lisp_Object file;
|
|
1361 int fd = openp (path, filename, suffixes, &file, predicate);
|
|
1362 if (NILP (predicate) && fd > 0)
|
|
1363 close (fd);
|
|
1364 return file;
|
|
1365 }
|
|
1366
|
|
1367
|
341
|
1368 /* Search for a file whose name is STR, looking in directories
|
|
1369 in the Lisp list PATH, and trying suffixes from SUFFIX.
|
|
1370 On success, returns a file descriptor. On failure, returns -1.
|
|
1371
|
39808
|
1372 SUFFIXES is a list of strings containing possible suffixes.
|
78501
|
1373 The empty suffix is automatically added if the list is empty.
|
39808
|
1374
|
45001
|
1375 PREDICATE non-nil means don't open the files,
|
|
1376 just look for one that satisfies the predicate. In this case,
|
|
1377 returns 1 on success. The predicate can be a lisp function or
|
|
1378 an integer to pass to `access' (in which case file-name-handlers
|
|
1379 are ignored).
|
341
|
1380
|
|
1381 If STOREPTR is nonzero, it points to a slot where the name of
|
|
1382 the file actually found should be stored as a Lisp string.
|
16937
|
1383 nil is stored there on failure.
|
|
1384
|
33442
|
1385 If the file we find is remote, return -2
|
45001
|
1386 but store the found remote file name in *STOREPTR. */
|
341
|
1387
|
|
1388 int
|
45001
|
1389 openp (path, str, suffixes, storeptr, predicate)
|
341
|
1390 Lisp_Object path, str;
|
39808
|
1391 Lisp_Object suffixes;
|
341
|
1392 Lisp_Object *storeptr;
|
45001
|
1393 Lisp_Object predicate;
|
341
|
1394 {
|
|
1395 register int fd;
|
|
1396 int fn_size = 100;
|
|
1397 char buf[100];
|
|
1398 register char *fn = buf;
|
|
1399 int absolute = 0;
|
|
1400 int want_size;
|
16937
|
1401 Lisp_Object filename;
|
341
|
1402 struct stat st;
|
44222
|
1403 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
|
|
1404 Lisp_Object string, tail, encoded_fn;
|
39808
|
1405 int max_suffix_len = 0;
|
|
1406
|
51380
|
1407 CHECK_STRING (str);
|
|
1408
|
40211
|
1409 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
|
|
1410 {
|
40690
ba7239b8872e
(Fload): Use XSETCARFASTINT, XSETCDRFASTINT instead of treating XCAR and XCDR
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1411 CHECK_STRING_CAR (tail);
|
40211
|
1412 max_suffix_len = max (max_suffix_len,
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1413 SBYTES (XCAR (tail)));
|
40211
|
1414 }
|
|
1415
|
68649
|
1416 string = filename = encoded_fn = Qnil;
|
44222
|
1417 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
|
|
1418
|
341
|
1419 if (storeptr)
|
|
1420 *storeptr = Qnil;
|
|
1421
|
|
1422 if (complete_filename_p (str))
|
|
1423 absolute = 1;
|
|
1424
|
39808
|
1425 for (; CONSP (path); path = XCDR (path))
|
341
|
1426 {
|
39808
|
1427 filename = Fexpand_file_name (str, XCAR (path));
|
341
|
1428 if (!complete_filename_p (filename))
|
|
1429 /* If there are non-absolute elts in PATH (eg ".") */
|
|
1430 /* Of course, this could conceivably lose if luser sets
|
|
1431 default-directory to be something non-absolute... */
|
|
1432 {
|
|
1433 filename = Fexpand_file_name (filename, current_buffer->directory);
|
|
1434 if (!complete_filename_p (filename))
|
|
1435 /* Give up on this path element! */
|
|
1436 continue;
|
|
1437 }
|
|
1438
|
|
1439 /* Calculate maximum size of any filename made from
|
|
1440 this path element/specified file name and any possible suffix. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1441 want_size = max_suffix_len + SBYTES (filename) + 1;
|
341
|
1442 if (fn_size < want_size)
|
|
1443 fn = (char *) alloca (fn_size = 100 + want_size);
|
|
1444
|
|
1445 /* Loop over suffixes. */
|
81270
0bf4e298d593
(syms_of_lread, openp): Use empty_unibyte_string, not build_string.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1446 for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
|
39808
|
1447 CONSP (tail); tail = XCDR (tail))
|
341
|
1448 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1449 int lsuffix = SBYTES (XCAR (tail));
|
16937
|
1450 Lisp_Object handler;
|
44222
|
1451 int exists;
|
341
|
1452
|
16383
|
1453 /* Concatenate path element/specified name with the suffix.
|
|
1454 If the directory starts with /:, remove that. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1455 if (SCHARS (filename) > 2
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1456 && SREF (filename, 0) == '/'
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1457 && SREF (filename, 1) == ':')
|
16383
|
1458 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1459 strncpy (fn, SDATA (filename) + 2,
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1460 SBYTES (filename) - 2);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1461 fn[SBYTES (filename) - 2] = 0;
|
16383
|
1462 }
|
|
1463 else
|
|
1464 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1465 strncpy (fn, SDATA (filename),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1466 SBYTES (filename));
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1467 fn[SBYTES (filename)] = 0;
|
16383
|
1468 }
|
|
1469
|
341
|
1470 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1471 strncat (fn, SDATA (XCAR (tail)), lsuffix);
|
44222
|
1472
|
16937
|
1473 /* Check that the file exists and is not a directory. */
|
39808
|
1474 /* We used to only check for handlers on non-absolute file names:
|
|
1475 if (absolute)
|
|
1476 handler = Qnil;
|
|
1477 else
|
|
1478 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
|
|
1479 It's not clear why that was the case and it breaks things like
|
|
1480 (load "/bar.el") where the file is actually "/bar.el.gz". */
|
44222
|
1481 string = build_string (fn);
|
50492
|
1482 handler = Ffind_file_name_handler (string, Qfile_exists_p);
|
45001
|
1483 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
|
|
1484 {
|
|
1485 if (NILP (predicate))
|
|
1486 exists = !NILP (Ffile_readable_p (string));
|
|
1487 else
|
|
1488 exists = !NILP (call1 (predicate, string));
|
44222
|
1489 if (exists && !NILP (Ffile_directory_p (string)))
|
16937
|
1490 exists = 0;
|
|
1491
|
|
1492 if (exists)
|
341
|
1493 {
|
|
1494 /* We succeeded; return this descriptor and filename. */
|
|
1495 if (storeptr)
|
44222
|
1496 *storeptr = string;
|
8906
|
1497 UNGCPRO;
|
33442
|
1498 return -2;
|
16937
|
1499 }
|
|
1500 }
|
|
1501 else
|
|
1502 {
|
46472
|
1503 const char *pfn;
|
44222
|
1504
|
|
1505 encoded_fn = ENCODE_FILE (string);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1506 pfn = SDATA (encoded_fn);
|
44222
|
1507 exists = (stat (pfn, &st) >= 0
|
|
1508 && (st.st_mode & S_IFMT) != S_IFDIR);
|
16937
|
1509 if (exists)
|
|
1510 {
|
|
1511 /* Check that we can access or open it. */
|
45001
|
1512 if (NATNUMP (predicate))
|
|
1513 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
|
16937
|
1514 else
|
44222
|
1515 fd = emacs_open (pfn, O_RDONLY, 0);
|
16937
|
1516
|
|
1517 if (fd >= 0)
|
|
1518 {
|
|
1519 /* We succeeded; return this descriptor and filename. */
|
|
1520 if (storeptr)
|
44222
|
1521 *storeptr = string;
|
16937
|
1522 UNGCPRO;
|
|
1523 return fd;
|
|
1524 }
|
341
|
1525 }
|
|
1526 }
|
|
1527 }
|
6392
|
1528 if (absolute)
|
8906
|
1529 break;
|
341
|
1530 }
|
|
1531
|
8906
|
1532 UNGCPRO;
|
|
1533 return -1;
|
341
|
1534 }
|
|
1535
|
|
1536
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1537 /* Merge the list we've accumulated of globals from the current input source
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1538 into the load_history variable. The details depend on whether
|
66333
|
1539 the source has an associated file name or not.
|
|
1540
|
|
1541 FILENAME is the file name that we are loading from.
|
|
1542 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1543
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1544 static void
|
66333
|
1545 build_load_history (filename, entire)
|
|
1546 Lisp_Object filename;
|
|
1547 int entire;
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1548 {
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1549 register Lisp_Object tail, prev, newelt;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1550 register Lisp_Object tem, tem2;
|
66333
|
1551 register int foundit = 0;
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1552
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1553 tail = Vload_history;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1554 prev = Qnil;
|
66333
|
1555
|
45001
|
1556 while (CONSP (tail))
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1557 {
|
45001
|
1558 tem = XCAR (tail);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1559
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1560 /* Find the feature's previous assoc list... */
|
66333
|
1561 if (!NILP (Fequal (filename, Fcar (tem))))
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1562 {
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1563 foundit = 1;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1564
|
66333
|
1565 /* If we're loading the entire file, remove old data. */
|
|
1566 if (entire)
|
45001
|
1567 {
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1568 if (NILP (prev))
|
45001
|
1569 Vload_history = XCDR (tail);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1570 else
|
45001
|
1571 Fsetcdr (prev, XCDR (tail));
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1572 }
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1573
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1574 /* Otherwise, cons on new symbols that are not already members. */
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1575 else
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1576 {
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1577 tem2 = Vcurrent_load_list;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1578
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1579 while (CONSP (tem2))
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1580 {
|
45001
|
1581 newelt = XCAR (tem2);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1582
|
47021
|
1583 if (NILP (Fmember (newelt, tem)))
|
45001
|
1584 Fsetcar (tail, Fcons (XCAR (tem),
|
|
1585 Fcons (newelt, XCDR (tem))));
|
|
1586
|
|
1587 tem2 = XCDR (tem2);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1588 QUIT;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1589 }
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1590 }
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1591 }
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1592 else
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1593 prev = tail;
|
45001
|
1594 tail = XCDR (tail);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1595 QUIT;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1596 }
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1597
|
66333
|
1598 /* If we're loading an entire file, cons the new assoc onto the
|
|
1599 front of load-history, the most-recently-loaded position. Also
|
|
1600 do this if we didn't find an existing member for the file. */
|
|
1601 if (entire || !foundit)
|
2901
|
1602 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
|
|
1603 Vload_history);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1604 }
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1605
|
341
|
1606 Lisp_Object
|
30917
|
1607 unreadpure (junk) /* Used as unwind-protect function in readevalloop */
|
|
1608 Lisp_Object junk;
|
341
|
1609 {
|
|
1610 read_pure = 0;
|
|
1611 return Qnil;
|
|
1612 }
|
|
1613
|
21677
|
1614 static Lisp_Object
|
|
1615 readevalloop_1 (old)
|
|
1616 Lisp_Object old;
|
|
1617 {
|
|
1618 load_convert_to_unibyte = ! NILP (old);
|
|
1619 return Qnil;
|
|
1620 }
|
|
1621
|
28733
|
1622 /* Signal an `end-of-file' error, if possible with file name
|
|
1623 information. */
|
|
1624
|
|
1625 static void
|
|
1626 end_of_file_error ()
|
|
1627 {
|
|
1628 if (STRINGP (Vload_file_name))
|
71984
|
1629 xsignal1 (Qend_of_file, Vload_file_name);
|
|
1630
|
|
1631 xsignal0 (Qend_of_file);
|
28733
|
1632 }
|
|
1633
|
21677
|
1634 /* UNIBYTE specifies how to set load_convert_to_unibyte
|
22420
|
1635 for this invocation.
|
61403
|
1636 READFUN, if non-nil, is used instead of `read'.
|
70595
|
1637
|
|
1638 START, END specify region to read in current buffer (from eval-region).
|
|
1639 If the input is not from a buffer, they must be nil. */
|
21677
|
1640
|
341
|
1641 static void
|
61403
|
1642 readevalloop (readcharfun, stream, sourcename, evalfun,
|
|
1643 printflag, unibyte, readfun, start, end)
|
341
|
1644 Lisp_Object readcharfun;
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1645 FILE *stream;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1646 Lisp_Object sourcename;
|
341
|
1647 Lisp_Object (*evalfun) ();
|
|
1648 int printflag;
|
22420
|
1649 Lisp_Object unibyte, readfun;
|
61403
|
1650 Lisp_Object start, end;
|
341
|
1651 {
|
|
1652 register int c;
|
|
1653 register Lisp_Object val;
|
46293
|
1654 int count = SPECPDL_INDEX ();
|
66937
|
1655 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
5185
|
1656 struct buffer *b = 0;
|
29486
|
1657 int continue_reading_p;
|
67906
|
1658 /* Nonzero if reading an entire buffer. */
|
|
1659 int whole_buffer = 0;
|
|
1660 /* 1 on the first time around. */
|
|
1661 int first_sexp = 1;
|
|
1662
|
|
1663 if (MARKERP (readcharfun))
|
|
1664 {
|
|
1665 if (NILP (start))
|
71837
|
1666 start = readcharfun;
|
67906
|
1667 }
|
5185
|
1668
|
|
1669 if (BUFFERP (readcharfun))
|
|
1670 b = XBUFFER (readcharfun);
|
|
1671 else if (MARKERP (readcharfun))
|
|
1672 b = XMARKER (readcharfun)->buffer;
|
341
|
1673
|
70595
|
1674 /* We assume START is nil when input is not from a buffer. */
|
|
1675 if (! NILP (start) && !b)
|
|
1676 abort ();
|
|
1677
|
66937
|
1678 specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
|
2901
|
1679 specbind (Qcurrent_load_list, Qnil);
|
21677
|
1680 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
|
|
1681 load_convert_to_unibyte = !NILP (unibyte);
|
341
|
1682
|
66937
|
1683 GCPRO4 (sourcename, readfun, start, end);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1684
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1685 /* Try to ensure sourcename is a truename, except whilst preloading. */
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1686 if (NILP (Vpurify_flag)
|
71673
1404a22bd1f5
(readevalloop): Remove unused var `bpos'. Yet another int/Lisp_Object mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1687 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
|
1404a22bd1f5
(readevalloop): Remove unused var `bpos'. Yet another int/Lisp_Object mixup.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1688 && !NILP (Ffboundp (Qfile_truename)))
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1689 sourcename = call1 (Qfile_truename, sourcename) ;
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1690
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1691 LOADHIST_ATTACH (sourcename);
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1692
|
29486
|
1693 continue_reading_p = 1;
|
|
1694 while (continue_reading_p)
|
341
|
1695 {
|
61403
|
1696 int count1 = SPECPDL_INDEX ();
|
|
1697
|
5185
|
1698 if (b != 0 && NILP (b->name))
|
|
1699 error ("Reading from killed buffer");
|
|
1700
|
61403
|
1701 if (!NILP (start))
|
|
1702 {
|
67871
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1703 /* Switch to the buffer we are reading from. */
|
61403
|
1704 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
67871
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1705 set_buffer_internal (b);
|
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1706
|
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1707 /* Save point in it. */
|
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1708 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1709 /* Save ZV in it. */
|
61403
|
1710 record_unwind_protect (save_restriction_restore, save_restriction_save ());
|
67871
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1711 /* Those get unbound after we read one expression. */
|
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1712
|
998f4ca6948d
(readevalloop): Set PT and ZV in the proper buffer, not the current one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1713 /* Set point and ZV around stuff to be read. */
|
61403
|
1714 Fgoto_char (start);
|
67906
|
1715 if (!NILP (end))
|
|
1716 Fnarrow_to_region (make_number (BEGV), end);
|
|
1717
|
|
1718 /* Just for cleanliness, convert END to a marker
|
|
1719 if it is an integer. */
|
|
1720 if (INTEGERP (end))
|
|
1721 end = Fpoint_max_marker ();
|
61403
|
1722 }
|
|
1723
|
67906
|
1724 /* On the first cycle, we can easily test here
|
|
1725 whether we are reading the whole buffer. */
|
|
1726 if (b && first_sexp)
|
|
1727 whole_buffer = (PT == BEG && ZV == Z);
|
|
1728
|
341
|
1729 instream = stream;
|
61403
|
1730 read_next:
|
341
|
1731 c = READCHAR;
|
|
1732 if (c == ';')
|
|
1733 {
|
|
1734 while ((c = READCHAR) != '\n' && c != -1);
|
61403
|
1735 goto read_next;
|
341
|
1736 }
|
61403
|
1737 if (c < 0)
|
|
1738 {
|
|
1739 unbind_to (count1, Qnil);
|
|
1740 break;
|
|
1741 }
|
10163
|
1742
|
|
1743 /* Ignore whitespace here, so we can detect eof. */
|
82214
|
1744 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
|
|
1745 || c == 0x8a0) /* NBSP */
|
61403
|
1746 goto read_next;
|
341
|
1747
|
485
|
1748 if (!NILP (Vpurify_flag) && c == '(')
|
341
|
1749 {
|
|
1750 record_unwind_protect (unreadpure, Qnil);
|
|
1751 val = read_list (-1, readcharfun);
|
|
1752 }
|
|
1753 else
|
|
1754 {
|
|
1755 UNREAD (c);
|
16141
|
1756 read_objects = Qnil;
|
29486
|
1757 if (!NILP (readfun))
|
|
1758 {
|
|
1759 val = call1 (readfun, readcharfun);
|
|
1760
|
|
1761 /* If READCHARFUN has set point to ZV, we should
|
|
1762 stop reading, even if the form read sets point
|
|
1763 to a different value when evaluated. */
|
|
1764 if (BUFFERP (readcharfun))
|
|
1765 {
|
|
1766 struct buffer *b = XBUFFER (readcharfun);
|
|
1767 if (BUF_PT (b) == BUF_ZV (b))
|
|
1768 continue_reading_p = 0;
|
|
1769 }
|
|
1770 }
|
22420
|
1771 else if (! NILP (Vload_read_function))
|
|
1772 val = call1 (Vload_read_function, readcharfun);
|
|
1773 else
|
45554
|
1774 val = read_internal_start (readcharfun, Qnil, Qnil);
|
341
|
1775 }
|
|
1776
|
61403
|
1777 if (!NILP (start) && continue_reading_p)
|
|
1778 start = Fpoint_marker ();
|
67906
|
1779
|
|
1780 /* Restore saved point and BEGV. */
|
61403
|
1781 unbind_to (count1, Qnil);
|
|
1782
|
67906
|
1783 /* Now eval what we just read. */
|
341
|
1784 val = (*evalfun) (val);
|
29486
|
1785
|
341
|
1786 if (printflag)
|
|
1787 {
|
|
1788 Vvalues = Fcons (val, Vvalues);
|
|
1789 if (EQ (Vstandard_output, Qt))
|
|
1790 Fprin1 (val, Qnil);
|
|
1791 else
|
|
1792 Fprint (val, Qnil);
|
|
1793 }
|
67906
|
1794
|
|
1795 first_sexp = 0;
|
341
|
1796 }
|
|
1797
|
71837
|
1798 build_load_history (sourcename,
|
67906
|
1799 stream || whole_buffer);
|
66333
|
1800
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1801 UNGCPRO;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1802
|
341
|
1803 unbind_to (count, Qnil);
|
|
1804 }
|
|
1805
|
25206
|
1806 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1807 doc: /* Execute the current buffer as Lisp code.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1808 Programs can pass two arguments, BUFFER and PRINTFLAG.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1809 BUFFER is the buffer to evaluate (nil means use current buffer).
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1810 PRINTFLAG controls printing of output:
|
74566
|
1811 A value of nil means discard it; anything else is stream for print.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1812
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1813 If the optional third argument FILENAME is non-nil,
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1814 it specifies the file name to use for `load-history'.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1815 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1816 for this invocation.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1817
|
48149
|
1818 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1819 `print' and related functions should work normally even if PRINTFLAG is nil.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1820
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1821 This function preserves the position of point. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1822 (buffer, printflag, filename, unibyte, do_allow_print)
|
25206
|
1823 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
|
672
|
1824 {
|
46293
|
1825 int count = SPECPDL_INDEX ();
|
672
|
1826 Lisp_Object tem, buf;
|
|
1827
|
14092
279f5f3528a8
(Feval_buffer, Feval_region, Fintern, Fintern_soft): Harmonize arguments
Erik Naggum <erik@naggum.no>
diff
changeset
|
1828 if (NILP (buffer))
|
672
|
1829 buf = Fcurrent_buffer ();
|
|
1830 else
|
14092
279f5f3528a8
(Feval_buffer, Feval_region, Fintern, Fintern_soft): Harmonize arguments
Erik Naggum <erik@naggum.no>
diff
changeset
|
1831 buf = Fget_buffer (buffer);
|
673
|
1832 if (NILP (buf))
|
19803
|
1833 error ("No such buffer");
|
672
|
1834
|
25206
|
1835 if (NILP (printflag) && NILP (do_allow_print))
|
672
|
1836 tem = Qsymbolp;
|
|
1837 else
|
|
1838 tem = printflag;
|
19803
|
1839
|
|
1840 if (NILP (filename))
|
|
1841 filename = XBUFFER (buf)->filename;
|
|
1842
|
64205
|
1843 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
|
672
|
1844 specbind (Qstandard_output, tem);
|
|
1845 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
93110
|
1846 BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
|
61403
|
1847 readevalloop (buf, 0, filename, Feval,
|
|
1848 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
|
1924
|
1849 unbind_to (count, Qnil);
|
672
|
1850
|
|
1851 return Qnil;
|
|
1852 }
|
|
1853
|
22420
|
1854 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1855 doc: /* Execute the region as Lisp code.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1856 When called from programs, expects two arguments,
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1857 giving starting and ending indices in the current buffer
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1858 of the text to be executed.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1859 Programs can pass third argument PRINTFLAG which controls output:
|
74566
|
1860 A value of nil means discard it; anything else is stream for printing it.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1861 Also the fourth argument READ-FUNCTION, if non-nil, is used
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1862 instead of `read' to read each expression. It gets one argument
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1863 which is the input stream for reading characters.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1864
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1865 This function does not move point. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1866 (start, end, printflag, read_function)
|
22420
|
1867 Lisp_Object start, end, printflag, read_function;
|
341
|
1868 {
|
46293
|
1869 int count = SPECPDL_INDEX ();
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1870 Lisp_Object tem, cbuf;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1871
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1872 cbuf = Fcurrent_buffer ();
|
341
|
1873
|
485
|
1874 if (NILP (printflag))
|
341
|
1875 tem = Qsymbolp;
|
|
1876 else
|
|
1877 tem = printflag;
|
|
1878 specbind (Qstandard_output, tem);
|
64205
|
1879 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
|
341
|
1880
|
61403
|
1881 /* readevalloop calls functions which check the type of start and end. */
|
21677
|
1882 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
|
61403
|
1883 !NILP (printflag), Qnil, read_function,
|
|
1884 start, end);
|
341
|
1885
|
|
1886 return unbind_to (count, Qnil);
|
|
1887 }
|
|
1888
|
|
1889
|
|
1890 DEFUN ("read", Fread, Sread, 0, 1, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1891 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1892 If STREAM is nil, use the value of `standard-input' (which see).
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1893 STREAM or the value of `standard-input' may be:
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1894 a buffer (read from point and advance it)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1895 a marker (read from where it points and advance it)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1896 a function (call it with no arguments for each character,
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1897 call it with a char as argument to push a char back)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1898 a string (takes text from string, starting at the beginning)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1899 t (read text line using minibuffer and use it, or read from
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1900 standard input in batch mode). */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1901 (stream)
|
12545
|
1902 Lisp_Object stream;
|
341
|
1903 {
|
12545
|
1904 if (NILP (stream))
|
|
1905 stream = Vstandard_input;
|
|
1906 if (EQ (stream, Qt))
|
|
1907 stream = Qread_char;
|
|
1908 if (EQ (stream, Qread_char))
|
341
|
1909 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
|
|
1910
|
45554
|
1911 return read_internal_start (stream, Qnil, Qnil);
|
341
|
1912 }
|
|
1913
|
|
1914 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1915 doc: /* Read one Lisp expression which is represented as text by STRING.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1916 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1917 START and END optionally delimit a substring of STRING from which to read;
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1918 they default to 0 and (length STRING) respectively. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
1919 (string, start, end)
|
341
|
1920 Lisp_Object string, start, end;
|
|
1921 {
|
45577
|
1922 Lisp_Object ret;
|
40656
|
1923 CHECK_STRING (string);
|
45577
|
1924 /* read_internal_start sets read_from_string_index. */
|
|
1925 ret = read_internal_start (string, start, end);
|
45576
|
1926 return Fcons (ret, make_number (read_from_string_index));
|
45554
|
1927 }
|
|
1928
|
|
1929 /* Function to set up the global context we need in toplevel read
|
|
1930 calls. */
|
|
1931 static Lisp_Object
|
|
1932 read_internal_start (stream, start, end)
|
|
1933 Lisp_Object stream;
|
|
1934 Lisp_Object start; /* Only used when stream is a string. */
|
|
1935 Lisp_Object end; /* Only used when stream is a string. */
|
|
1936 {
|
|
1937 Lisp_Object retval;
|
|
1938
|
|
1939 readchar_count = 0;
|
11683
|
1940 new_backquote_flag = 0;
|
16141
|
1941 read_objects = Qnil;
|
45554
|
1942 if (EQ (Vread_with_symbol_positions, Qt)
|
|
1943 || EQ (Vread_with_symbol_positions, stream))
|
|
1944 Vread_symbol_positions_list = Qnil;
|
|
1945
|
89483
|
1946 if (STRINGP (stream)
|
|
1947 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
|
45554
|
1948 {
|
|
1949 int startval, endval;
|
89483
|
1950 Lisp_Object string;
|
|
1951
|
|
1952 if (STRINGP (stream))
|
|
1953 string = stream;
|
|
1954 else
|
|
1955 string = XCAR (stream);
|
|
1956
|
45554
|
1957 if (NILP (end))
|
89483
|
1958 endval = SCHARS (string);
|
45554
|
1959 else
|
|
1960 {
|
|
1961 CHECK_NUMBER (end);
|
|
1962 endval = XINT (end);
|
89483
|
1963 if (endval < 0 || endval > SCHARS (string))
|
|
1964 args_out_of_range (string, end);
|
45554
|
1965 }
|
|
1966
|
|
1967 if (NILP (start))
|
|
1968 startval = 0;
|
|
1969 else
|
|
1970 {
|
|
1971 CHECK_NUMBER (start);
|
|
1972 startval = XINT (start);
|
|
1973 if (startval < 0 || startval > endval)
|
89483
|
1974 args_out_of_range (string, start);
|
45554
|
1975 }
|
|
1976 read_from_string_index = startval;
|
89483
|
1977 read_from_string_index_byte = string_char_to_byte (string, startval);
|
45554
|
1978 read_from_string_limit = endval;
|
|
1979 }
|
49600
|
1980
|
45554
|
1981 retval = read0 (stream);
|
|
1982 if (EQ (Vread_with_symbol_positions, Qt)
|
|
1983 || EQ (Vread_with_symbol_positions, stream))
|
|
1984 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
|
|
1985 return retval;
|
341
|
1986 }
|
|
1987
|
71984
|
1988
|
|
1989 /* Signal Qinvalid_read_syntax error.
|
|
1990 S is error string of length N (if > 0) */
|
|
1991
|
|
1992 static void
|
|
1993 invalid_syntax (s, n)
|
|
1994 const char *s;
|
|
1995 int n;
|
|
1996 {
|
|
1997 if (!n)
|
|
1998 n = strlen (s);
|
|
1999 xsignal1 (Qinvalid_read_syntax, make_string (s, n));
|
|
2000 }
|
|
2001
|
|
2002
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2003 /* Use this for recursive reads, in contexts where internal tokens
|
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2004 are not allowed. */
|
20609
|
2005
|
341
|
2006 static Lisp_Object
|
|
2007 read0 (readcharfun)
|
|
2008 Lisp_Object readcharfun;
|
|
2009 {
|
|
2010 register Lisp_Object val;
|
20609
|
2011 int c;
|
341
|
2012
|
11683
|
2013 val = read1 (readcharfun, &c, 0);
|
71984
|
2014 if (!c)
|
|
2015 return val;
|
|
2016
|
|
2017 xsignal1 (Qinvalid_read_syntax,
|
|
2018 Fmake_string (make_number (1), make_number (c)));
|
341
|
2019 }
|
|
2020
|
|
2021 static int read_buffer_size;
|
|
2022 static char *read_buffer;
|
|
2023
|
88886
|
2024 /* Read a \-escape sequence, assuming we already read the `\'.
|
89483
|
2025 If the escape sequence forces unibyte, return eight-bit char. */
|
20548
|
2026
|
17038
|
2027 static int
|
88886
|
2028 read_escape (readcharfun, stringp)
|
341
|
2029 Lisp_Object readcharfun;
|
20669
|
2030 int stringp;
|
341
|
2031 {
|
|
2032 register int c = READCHAR;
|
71299
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2033 /* \u allows up to four hex digits, \U up to eight. Default to the
|
96376
|
2034 behavior for \u, and change this value in the case that \U is seen. */
|
71299
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2035 int unicode_hex_count = 4;
|
42424
|
2036
|
341
|
2037 switch (c)
|
|
2038 {
|
15091
|
2039 case -1:
|
40931
|
2040 end_of_file_error ();
|
15091
|
2041
|
341
|
2042 case 'a':
|
485
|
2043 return '\007';
|
341
|
2044 case 'b':
|
|
2045 return '\b';
|
2018
|
2046 case 'd':
|
|
2047 return 0177;
|
341
|
2048 case 'e':
|
|
2049 return 033;
|
|
2050 case 'f':
|
|
2051 return '\f';
|
|
2052 case 'n':
|
|
2053 return '\n';
|
|
2054 case 'r':
|
|
2055 return '\r';
|
|
2056 case 't':
|
|
2057 return '\t';
|
|
2058 case 'v':
|
|
2059 return '\v';
|
|
2060 case '\n':
|
|
2061 return -1;
|
20609
|
2062 case ' ':
|
20669
|
2063 if (stringp)
|
|
2064 return -1;
|
|
2065 return ' ';
|
341
|
2066
|
|
2067 case 'M':
|
|
2068 c = READCHAR;
|
|
2069 if (c != '-')
|
|
2070 error ("Invalid escape character syntax");
|
|
2071 c = READCHAR;
|
|
2072 if (c == '\\')
|
88886
|
2073 c = read_escape (readcharfun, 0);
|
2044
|
2074 return c | meta_modifier;
|
2018
|
2075
|
|
2076 case 'S':
|
|
2077 c = READCHAR;
|
|
2078 if (c != '-')
|
|
2079 error ("Invalid escape character syntax");
|
|
2080 c = READCHAR;
|
|
2081 if (c == '\\')
|
88886
|
2082 c = read_escape (readcharfun, 0);
|
2044
|
2083 return c | shift_modifier;
|
|
2084
|
|
2085 case 'H':
|
|
2086 c = READCHAR;
|
|
2087 if (c != '-')
|
|
2088 error ("Invalid escape character syntax");
|
|
2089 c = READCHAR;
|
|
2090 if (c == '\\')
|
88886
|
2091 c = read_escape (readcharfun, 0);
|
2044
|
2092 return c | hyper_modifier;
|
|
2093
|
|
2094 case 'A':
|
|
2095 c = READCHAR;
|
|
2096 if (c != '-')
|
|
2097 error ("Invalid escape character syntax");
|
|
2098 c = READCHAR;
|
|
2099 if (c == '\\')
|
88886
|
2100 c = read_escape (readcharfun, 0);
|
2044
|
2101 return c | alt_modifier;
|
|
2102
|
|
2103 case 's':
|
|
2104 c = READCHAR;
|
80808
|
2105 if (stringp || c != '-')
|
67394
|
2106 {
|
|
2107 UNREAD (c);
|
|
2108 return ' ';
|
|
2109 }
|
2044
|
2110 c = READCHAR;
|
|
2111 if (c == '\\')
|
88886
|
2112 c = read_escape (readcharfun, 0);
|
2044
|
2113 return c | super_modifier;
|
341
|
2114
|
|
2115 case 'C':
|
|
2116 c = READCHAR;
|
|
2117 if (c != '-')
|
|
2118 error ("Invalid escape character syntax");
|
|
2119 case '^':
|
|
2120 c = READCHAR;
|
|
2121 if (c == '\\')
|
88886
|
2122 c = read_escape (readcharfun, 0);
|
25251
|
2123 if ((c & ~CHAR_MODIFIER_MASK) == '?')
|
|
2124 return 0177 | (c & CHAR_MODIFIER_MASK);
|
|
2125 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
|
|
2126 return c | ctrl_modifier;
|
2018
|
2127 /* ASCII control chars are made from letters (both cases),
|
|
2128 as well as the non-letters within 0100...0137. */
|
|
2129 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
|
|
2130 return (c & (037 | ~0177));
|
|
2131 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
|
|
2132 return (c & (037 | ~0177));
|
341
|
2133 else
|
2044
|
2134 return c | ctrl_modifier;
|
341
|
2135
|
|
2136 case '0':
|
|
2137 case '1':
|
|
2138 case '2':
|
|
2139 case '3':
|
|
2140 case '4':
|
|
2141 case '5':
|
|
2142 case '6':
|
|
2143 case '7':
|
|
2144 /* An octal escape, as in ANSI C. */
|
|
2145 {
|
|
2146 register int i = c - '0';
|
|
2147 register int count = 0;
|
|
2148 while (++count < 3)
|
|
2149 {
|
|
2150 if ((c = READCHAR) >= '0' && c <= '7')
|
|
2151 {
|
|
2152 i *= 8;
|
|
2153 i += c - '0';
|
|
2154 }
|
|
2155 else
|
|
2156 {
|
|
2157 UNREAD (c);
|
|
2158 break;
|
|
2159 }
|
|
2160 }
|
49600
|
2161
|
89483
|
2162 if (i >= 0x80 && i < 0x100)
|
88886
|
2163 i = BYTE8_TO_CHAR (i);
|
341
|
2164 return i;
|
|
2165 }
|
|
2166
|
|
2167 case 'x':
|
|
2168 /* A hex escape, as in ANSI C. */
|
|
2169 {
|
|
2170 int i = 0;
|
88383
|
2171 int count = 0;
|
341
|
2172 while (1)
|
|
2173 {
|
|
2174 c = READCHAR;
|
|
2175 if (c >= '0' && c <= '9')
|
|
2176 {
|
|
2177 i *= 16;
|
|
2178 i += c - '0';
|
|
2179 }
|
|
2180 else if ((c >= 'a' && c <= 'f')
|
|
2181 || (c >= 'A' && c <= 'F'))
|
|
2182 {
|
|
2183 i *= 16;
|
|
2184 if (c >= 'a' && c <= 'f')
|
|
2185 i += c - 'a' + 10;
|
|
2186 else
|
|
2187 i += c - 'A' + 10;
|
|
2188 }
|
|
2189 else
|
|
2190 {
|
|
2191 UNREAD (c);
|
|
2192 break;
|
|
2193 }
|
88383
|
2194 count++;
|
341
|
2195 }
|
42424
|
2196
|
88383
|
2197 if (count < 3 && i >= 0x80)
|
88886
|
2198 return BYTE8_TO_CHAR (i);
|
341
|
2199 return i;
|
|
2200 }
|
|
2201
|
71299
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2202 case 'U':
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2203 /* Post-Unicode-2.0: Up to eight hex chars. */
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2204 unicode_hex_count = 8;
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2205 case 'u':
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2206
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2207 /* A Unicode escape. We only permit them in strings and characters,
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2208 not arbitrarily in the source code, as in some other languages. */
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2209 {
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2210 int i = 0;
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2211 int count = 0;
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2212
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2213 while (++count <= unicode_hex_count)
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2214 {
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2215 c = READCHAR;
|
71484
|
2216 /* isdigit and isalpha may be locale-specific, which we don't
|
71299
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2217 want. */
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2218 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2219 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2220 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2221 else
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2222 {
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2223 error ("Non-hex digit used for Unicode escape");
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2224 break;
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2225 }
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2226 }
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2227
|
90478
|
2228 return i;
|
71299
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2229 }
|
767eeffaf27a
(read_escape): Provide a Unicode character escape syntax; \u followed by
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2230
|
341
|
2231 default:
|
|
2232 return c;
|
|
2233 }
|
|
2234 }
|
|
2235
|
28165
|
2236 /* Read an integer in radix RADIX using READCHARFUN to read
|
|
2237 characters. RADIX must be in the interval [2..36]; if it isn't, a
|
|
2238 read error is signaled . Value is the integer read. Signals an
|
|
2239 error if encountering invalid read syntax or if RADIX is out of
|
|
2240 range. */
|
|
2241
|
|
2242 static Lisp_Object
|
|
2243 read_integer (readcharfun, radix)
|
|
2244 Lisp_Object readcharfun;
|
|
2245 int radix;
|
|
2246 {
|
35543
|
2247 int ndigits = 0, invalid_p, c, sign = 0;
|
|
2248 EMACS_INT number = 0;
|
28165
|
2249
|
|
2250 if (radix < 2 || radix > 36)
|
|
2251 invalid_p = 1;
|
|
2252 else
|
|
2253 {
|
|
2254 number = ndigits = invalid_p = 0;
|
|
2255 sign = 1;
|
|
2256
|
|
2257 c = READCHAR;
|
|
2258 if (c == '-')
|
|
2259 {
|
|
2260 c = READCHAR;
|
|
2261 sign = -1;
|
|
2262 }
|
|
2263 else if (c == '+')
|
|
2264 c = READCHAR;
|
49600
|
2265
|
28165
|
2266 while (c >= 0)
|
|
2267 {
|
|
2268 int digit;
|
49600
|
2269
|
28165
|
2270 if (c >= '0' && c <= '9')
|
|
2271 digit = c - '0';
|
|
2272 else if (c >= 'a' && c <= 'z')
|
|
2273 digit = c - 'a' + 10;
|
|
2274 else if (c >= 'A' && c <= 'Z')
|
|
2275 digit = c - 'A' + 10;
|
|
2276 else
|
28190
|
2277 {
|
|
2278 UNREAD (c);
|
|
2279 break;
|
|
2280 }
|
28165
|
2281
|
|
2282 if (digit < 0 || digit >= radix)
|
|
2283 invalid_p = 1;
|
|
2284
|
|
2285 number = radix * number + digit;
|
|
2286 ++ndigits;
|
|
2287 c = READCHAR;
|
|
2288 }
|
|
2289 }
|
|
2290
|
|
2291 if (ndigits == 0 || invalid_p)
|
|
2292 {
|
|
2293 char buf[50];
|
|
2294 sprintf (buf, "integer, radix %d", radix);
|
71984
|
2295 invalid_syntax (buf, 0);
|
28165
|
2296 }
|
|
2297
|
|
2298 return make_number (sign * number);
|
|
2299 }
|
|
2300
|
|
2301
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2302 /* If the next token is ')' or ']' or '.', we store that character
|
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2303 in *PCH and the return value is not interesting. Else, we store
|
11683
|
2304 zero in *PCH and we read and return one lisp object.
|
|
2305
|
|
2306 FIRST_IN_LIST is nonzero if this is the first element of a list. */
|
|
2307
|
341
|
2308 static Lisp_Object
|
11683
|
2309 read1 (readcharfun, pch, first_in_list)
|
341
|
2310 register Lisp_Object readcharfun;
|
20609
|
2311 int *pch;
|
11683
|
2312 int first_in_list;
|
341
|
2313 {
|
|
2314 register int c;
|
16141
|
2315 int uninterned_symbol = 0;
|
91093
|
2316 int multibyte;
|
16141
|
2317
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2318 *pch = 0;
|
88886
|
2319 load_each_byte = 0;
|
341
|
2320
|
|
2321 retry:
|
|
2322
|
91093
|
2323 c = READCHAR_REPORT_MULTIBYTE (&multibyte);
|
28733
|
2324 if (c < 0)
|
|
2325 end_of_file_error ();
|
341
|
2326
|
|
2327 switch (c)
|
|
2328 {
|
|
2329 case '(':
|
|
2330 return read_list (0, readcharfun);
|
|
2331
|
|
2332 case '[':
|
22321
|
2333 return read_vector (readcharfun, 0);
|
341
|
2334
|
|
2335 case ')':
|
|
2336 case ']':
|
|
2337 {
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2338 *pch = c;
|
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2339 return Qnil;
|
341
|
2340 }
|
|
2341
|
|
2342 case '#':
|
373
|
2343 c = READCHAR;
|
13146
|
2344 if (c == '^')
|
|
2345 {
|
|
2346 c = READCHAR;
|
|
2347 if (c == '[')
|
|
2348 {
|
|
2349 Lisp_Object tmp;
|
22321
|
2350 tmp = read_vector (readcharfun, 0);
|
90830
|
2351 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
|
13146
|
2352 error ("Invalid size char-table");
|
85356
|
2353 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
|
13146
|
2354 return tmp;
|
|
2355 }
|
17325
|
2356 else if (c == '^')
|
|
2357 {
|
|
2358 c = READCHAR;
|
|
2359 if (c == '[')
|
|
2360 {
|
|
2361 Lisp_Object tmp;
|
88383
|
2362 int depth, size;
|
89483
|
2363
|
22321
|
2364 tmp = read_vector (readcharfun, 0);
|
88383
|
2365 if (!INTEGERP (AREF (tmp, 0)))
|
|
2366 error ("Invalid depth in char-table");
|
|
2367 depth = XINT (AREF (tmp, 0));
|
|
2368 if (depth < 1 || depth > 3)
|
|
2369 error ("Invalid depth in char-table");
|
89996
|
2370 size = XVECTOR (tmp)->size - 2;
|
88383
|
2371 if (chartab_size [depth] != size)
|
17325
|
2372 error ("Invalid size char-table");
|
91046
|
2373 XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
|
17325
|
2374 return tmp;
|
|
2375 }
|
71984
|
2376 invalid_syntax ("#^^", 3);
|
17325
|
2377 }
|
71984
|
2378 invalid_syntax ("#^", 2);
|
13146
|
2379 }
|
|
2380 if (c == '&')
|
|
2381 {
|
|
2382 Lisp_Object length;
|
|
2383 length = read1 (readcharfun, pch, first_in_list);
|
|
2384 c = READCHAR;
|
|
2385 if (c == '"')
|
|
2386 {
|
|
2387 Lisp_Object tmp, val;
|
55158
e69f42e233dc
(read1): Use BOOL_VECTOR_BITS_PER_CHAR instead of BITS_PER_CHAR for
Andreas Schwab <schwab@suse.de>
diff
changeset
|
2388 int size_in_chars
|
e69f42e233dc
(read1): Use BOOL_VECTOR_BITS_PER_CHAR instead of BITS_PER_CHAR for
Andreas Schwab <schwab@suse.de>
diff
changeset
|
2389 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
|
e69f42e233dc
(read1): Use BOOL_VECTOR_BITS_PER_CHAR instead of BITS_PER_CHAR for
Andreas Schwab <schwab@suse.de>
diff
changeset
|
2390 / BOOL_VECTOR_BITS_PER_CHAR);
|
13146
|
2391
|
|
2392 UNREAD (c);
|
|
2393 tmp = read1 (readcharfun, pch, first_in_list);
|
88886
|
2394 if (STRING_MULTIBYTE (tmp)
|
89483
|
2395 || (size_in_chars != SCHARS (tmp)
|
88886
|
2396 /* We used to print 1 char too many
|
|
2397 when the number of bits was a multiple of 8.
|
|
2398 Accept such input in case it came from an old
|
|
2399 version. */
|
|
2400 && ! (XFASTINT (length)
|
89943
|
2401 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
|
71984
|
2402 invalid_syntax ("#&...", 5);
|
49600
|
2403
|
13146
|
2404 val = Fmake_bool_vector (length, Qnil);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2405 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
|
13146
|
2406 size_in_chars);
|
21935
|
2407 /* Clear the extraneous bits in the last byte. */
|
55158
e69f42e233dc
(read1): Use BOOL_VECTOR_BITS_PER_CHAR instead of BITS_PER_CHAR for
Andreas Schwab <schwab@suse.de>
diff
changeset
|
2408 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
|
21935
|
2409 XBOOL_VECTOR (val)->data[size_in_chars - 1]
|
55158
e69f42e233dc
(read1): Use BOOL_VECTOR_BITS_PER_CHAR instead of BITS_PER_CHAR for
Andreas Schwab <schwab@suse.de>
diff
changeset
|
2410 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
|
13146
|
2411 return val;
|
|
2412 }
|
71984
|
2413 invalid_syntax ("#&...", 5);
|
13146
|
2414 }
|
373
|
2415 if (c == '[')
|
|
2416 {
|
|
2417 /* Accept compiled functions at read-time so that we don't have to
|
|
2418 build them using function calls. */
|
1966
|
2419 Lisp_Object tmp;
|
22321
|
2420 tmp = read_vector (readcharfun, 1);
|
1966
|
2421 return Fmake_byte_code (XVECTOR (tmp)->size,
|
|
2422 XVECTOR (tmp)->contents);
|
373
|
2423 }
|
1966
|
2424 if (c == '(')
|
|
2425 {
|
|
2426 Lisp_Object tmp;
|
|
2427 struct gcpro gcpro1;
|
20609
|
2428 int ch;
|
1966
|
2429
|
|
2430 /* Read the string itself. */
|
11683
|
2431 tmp = read1 (readcharfun, &ch, 0);
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2432 if (ch != 0 || !STRINGP (tmp))
|
71984
|
2433 invalid_syntax ("#", 1);
|
1966
|
2434 GCPRO1 (tmp);
|
|
2435 /* Read the intervals and their properties. */
|
|
2436 while (1)
|
|
2437 {
|
|
2438 Lisp_Object beg, end, plist;
|
|
2439
|
11683
|
2440 beg = read1 (readcharfun, &ch, 0);
|
31534
|
2441 end = plist = Qnil;
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2442 if (ch == ')')
|
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2443 break;
|
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2444 if (ch == 0)
|
11683
|
2445 end = read1 (readcharfun, &ch, 0);
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2446 if (ch == 0)
|
11683
|
2447 plist = read1 (readcharfun, &ch, 0);
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2448 if (ch)
|
71984
|
2449 invalid_syntax ("Invalid string property list", 0);
|
1966
|
2450 Fset_text_properties (beg, end, plist, tmp);
|
|
2451 }
|
|
2452 UNGCPRO;
|
|
2453 return tmp;
|
|
2454 }
|
49600
|
2455
|
10200
|
2456 /* #@NUMBER is used to skip NUMBER following characters.
|
|
2457 That's used in .elc files to skip over doc strings
|
|
2458 and function definitions. */
|
|
2459 if (c == '@')
|
|
2460 {
|
|
2461 int i, nskip = 0;
|
|
2462
|
88886
|
2463 load_each_byte = 1;
|
10200
|
2464 /* Read a decimal integer. */
|
|
2465 while ((c = READCHAR) >= 0
|
|
2466 && c >= '0' && c <= '9')
|
|
2467 {
|
|
2468 nskip *= 10;
|
|
2469 nskip += c - '0';
|
|
2470 }
|
|
2471 if (c >= 0)
|
|
2472 UNREAD (c);
|
49600
|
2473
|
88886
|
2474 if (load_force_doc_strings
|
|
2475 && (EQ (readcharfun, Qget_file_char)
|
|
2476 || EQ (readcharfun, Qget_emacs_mule_file_char)))
|
12780
|
2477 {
|
|
2478 /* If we are supposed to force doc strings into core right now,
|
|
2479 record the last string that we skipped,
|
|
2480 and record where in the file it comes from. */
|
22321
|
2481
|
|
2482 /* But first exchange saved_doc_string
|
|
2483 with prev_saved_doc_string, so we save two strings. */
|
|
2484 {
|
|
2485 char *temp = saved_doc_string;
|
|
2486 int temp_size = saved_doc_string_size;
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2487 file_offset temp_pos = saved_doc_string_position;
|
22321
|
2488 int temp_len = saved_doc_string_length;
|
|
2489
|
|
2490 saved_doc_string = prev_saved_doc_string;
|
|
2491 saved_doc_string_size = prev_saved_doc_string_size;
|
|
2492 saved_doc_string_position = prev_saved_doc_string_position;
|
|
2493 saved_doc_string_length = prev_saved_doc_string_length;
|
|
2494
|
|
2495 prev_saved_doc_string = temp;
|
|
2496 prev_saved_doc_string_size = temp_size;
|
|
2497 prev_saved_doc_string_position = temp_pos;
|
|
2498 prev_saved_doc_string_length = temp_len;
|
|
2499 }
|
|
2500
|
12780
|
2501 if (saved_doc_string_size == 0)
|
|
2502 {
|
|
2503 saved_doc_string_size = nskip + 100;
|
14130
|
2504 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
|
12780
|
2505 }
|
|
2506 if (nskip > saved_doc_string_size)
|
|
2507 {
|
|
2508 saved_doc_string_size = nskip + 100;
|
14130
|
2509 saved_doc_string = (char *) xrealloc (saved_doc_string,
|
|
2510 saved_doc_string_size);
|
12780
|
2511 }
|
|
2512
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2513 saved_doc_string_position = file_tell (instream);
|
12780
|
2514
|
|
2515 /* Copy that many characters into saved_doc_string. */
|
|
2516 for (i = 0; i < nskip && c >= 0; i++)
|
|
2517 saved_doc_string[i] = c = READCHAR;
|
|
2518
|
|
2519 saved_doc_string_length = i;
|
|
2520 }
|
|
2521 else
|
|
2522 {
|
|
2523 /* Skip that many characters. */
|
|
2524 for (i = 0; i < nskip && c >= 0; i++)
|
|
2525 c = READCHAR;
|
|
2526 }
|
20048
|
2527
|
88886
|
2528 load_each_byte = 0;
|
10200
|
2529 goto retry;
|
|
2530 }
|
47184
|
2531 if (c == '!')
|
|
2532 {
|
|
2533 /* #! appears at the beginning of an executable file.
|
|
2534 Skip the first line. */
|
50138
|
2535 while (c != '\n' && c >= 0)
|
47184
|
2536 c = READCHAR;
|
|
2537 goto retry;
|
|
2538 }
|
10200
|
2539 if (c == '$')
|
|
2540 return Vload_file_name;
|
13235
|
2541 if (c == '\'')
|
|
2542 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
|
16141
|
2543 /* #:foo is the uninterned symbol named foo. */
|
|
2544 if (c == ':')
|
|
2545 {
|
|
2546 uninterned_symbol = 1;
|
|
2547 c = READCHAR;
|
|
2548 goto default_label;
|
|
2549 }
|
|
2550 /* Reader forms that can reuse previously read objects. */
|
|
2551 if (c >= '0' && c <= '9')
|
|
2552 {
|
|
2553 int n = 0;
|
|
2554 Lisp_Object tem;
|
13235
|
2555
|
16141
|
2556 /* Read a non-negative integer. */
|
|
2557 while (c >= '0' && c <= '9')
|
|
2558 {
|
|
2559 n *= 10;
|
|
2560 n += c - '0';
|
|
2561 c = READCHAR;
|
|
2562 }
|
|
2563 /* #n=object returns object, but associates it with n for #n#. */
|
|
2564 if (c == '=')
|
|
2565 {
|
25165
|
2566 /* Make a placeholder for #n# to use temporarily */
|
|
2567 Lisp_Object placeholder;
|
|
2568 Lisp_Object cell;
|
|
2569
|
|
2570 placeholder = Fcons(Qnil, Qnil);
|
|
2571 cell = Fcons (make_number (n), placeholder);
|
|
2572 read_objects = Fcons (cell, read_objects);
|
|
2573
|
|
2574 /* Read the object itself. */
|
16141
|
2575 tem = read0 (readcharfun);
|
25165
|
2576
|
|
2577 /* Now put it everywhere the placeholder was... */
|
|
2578 substitute_object_in_subtree (tem, placeholder);
|
|
2579
|
|
2580 /* ...and #n# will use the real value from now on. */
|
|
2581 Fsetcdr (cell, tem);
|
49600
|
2582
|
16141
|
2583 return tem;
|
|
2584 }
|
|
2585 /* #n# returns a previously read object. */
|
|
2586 if (c == '#')
|
|
2587 {
|
|
2588 tem = Fassq (make_number (n), read_objects);
|
|
2589 if (CONSP (tem))
|
|
2590 return XCDR (tem);
|
|
2591 /* Fall through to error message. */
|
|
2592 }
|
28165
|
2593 else if (c == 'r' || c == 'R')
|
|
2594 return read_integer (readcharfun, n);
|
49600
|
2595
|
16141
|
2596 /* Fall through to error message. */
|
|
2597 }
|
28165
|
2598 else if (c == 'x' || c == 'X')
|
|
2599 return read_integer (readcharfun, 16);
|
|
2600 else if (c == 'o' || c == 'O')
|
|
2601 return read_integer (readcharfun, 8);
|
|
2602 else if (c == 'b' || c == 'B')
|
|
2603 return read_integer (readcharfun, 2);
|
10200
|
2604
|
373
|
2605 UNREAD (c);
|
71984
|
2606 invalid_syntax ("#", 1);
|
341
|
2607
|
|
2608 case ';':
|
|
2609 while ((c = READCHAR) >= 0 && c != '\n');
|
|
2610 goto retry;
|
|
2611
|
|
2612 case '\'':
|
|
2613 {
|
|
2614 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
|
|
2615 }
|
|
2616
|
11683
|
2617 case '`':
|
|
2618 if (first_in_list)
|
78612
|
2619 {
|
|
2620 Vold_style_backquotes = Qt;
|
|
2621 goto default_label;
|
|
2622 }
|
11683
|
2623 else
|
|
2624 {
|
|
2625 Lisp_Object value;
|
|
2626
|
40784
|
2627 new_backquote_flag++;
|
11683
|
2628 value = read0 (readcharfun);
|
40784
|
2629 new_backquote_flag--;
|
11683
|
2630
|
|
2631 return Fcons (Qbackquote, Fcons (value, Qnil));
|
|
2632 }
|
|
2633
|
|
2634 case ',':
|
|
2635 if (new_backquote_flag)
|
|
2636 {
|
|
2637 Lisp_Object comma_type = Qnil;
|
|
2638 Lisp_Object value;
|
|
2639 int ch = READCHAR;
|
|
2640
|
|
2641 if (ch == '@')
|
|
2642 comma_type = Qcomma_at;
|
|
2643 else if (ch == '.')
|
|
2644 comma_type = Qcomma_dot;
|
|
2645 else
|
|
2646 {
|
|
2647 if (ch >= 0) UNREAD (ch);
|
|
2648 comma_type = Qcomma;
|
|
2649 }
|
|
2650
|
40784
|
2651 new_backquote_flag--;
|
11683
|
2652 value = read0 (readcharfun);
|
40784
|
2653 new_backquote_flag++;
|
11683
|
2654 return Fcons (comma_type, Fcons (value, Qnil));
|
|
2655 }
|
|
2656 else
|
78612
|
2657 {
|
|
2658 Vold_style_backquotes = Qt;
|
|
2659 goto default_label;
|
|
2660 }
|
11683
|
2661
|
341
|
2662 case '?':
|
|
2663 {
|
88886
|
2664 int modifiers;
|
49831
|
2665 int next_char;
|
|
2666 int ok;
|
42424
|
2667
|
341
|
2668 c = READCHAR;
|
28733
|
2669 if (c < 0)
|
|
2670 end_of_file_error ();
|
341
|
2671
|
49979
|
2672 /* Accept `single space' syntax like (list ? x) where the
|
|
2673 whitespace character is SPC or TAB.
|
|
2674 Other literal whitespace like NL, CR, and FF are not accepted,
|
|
2675 as there are well-established escape sequences for these. */
|
|
2676 if (c == ' ' || c == '\t')
|
|
2677 return make_number (c);
|
|
2678
|
341
|
2679 if (c == '\\')
|
88886
|
2680 c = read_escape (readcharfun, 0);
|
|
2681 modifiers = c & CHAR_MODIFIER_MASK;
|
|
2682 c &= ~CHAR_MODIFIER_MASK;
|
|
2683 if (CHAR_BYTE8_P (c))
|
|
2684 c = CHAR_TO_BYTE8 (c);
|
|
2685 c |= modifiers;
|
20548
|
2686
|
49831
|
2687 next_char = READCHAR;
|
|
2688 if (next_char == '.')
|
|
2689 {
|
|
2690 /* Only a dotted-pair dot is valid after a char constant. */
|
|
2691 int next_next_char = READCHAR;
|
|
2692 UNREAD (next_next_char);
|
|
2693
|
|
2694 ok = (next_next_char <= 040
|
50513
|
2695 || (next_next_char < 0200
|
|
2696 && (index ("\"';([#?", next_next_char)
|
|
2697 || (!first_in_list && next_next_char == '`')
|
|
2698 || (new_backquote_flag && next_next_char == ','))));
|
49831
|
2699 }
|
|
2700 else
|
|
2701 {
|
|
2702 ok = (next_char <= 040
|
50513
|
2703 || (next_char < 0200
|
|
2704 && (index ("\"';()[]#?", next_char)
|
|
2705 || (!first_in_list && next_char == '`')
|
|
2706 || (new_backquote_flag && next_char == ','))));
|
49831
|
2707 }
|
|
2708 UNREAD (next_char);
|
71984
|
2709 if (ok)
|
|
2710 return make_number (c);
|
|
2711
|
|
2712 invalid_syntax ("?", 1);
|
341
|
2713 }
|
|
2714
|
22103
|
2715 case '"':
|
341
|
2716 {
|
40503
|
2717 char *p = read_buffer;
|
|
2718 char *end = read_buffer + read_buffer_size;
|
341
|
2719 register int c;
|
88383
|
2720 /* Nonzero if we saw an escape sequence specifying
|
|
2721 a multibyte character. */
|
20669
|
2722 int force_multibyte = 0;
|
88383
|
2723 /* Nonzero if we saw an escape sequence specifying
|
20669
|
2724 a single-byte character. */
|
|
2725 int force_singlebyte = 0;
|
341
|
2726 int cancel = 0;
|
43080
|
2727 int nchars = 0;
|
341
|
2728
|
|
2729 while ((c = READCHAR) >= 0
|
|
2730 && c != '\"')
|
|
2731 {
|
26866
|
2732 if (end - p < MAX_MULTIBYTE_LENGTH)
|
341
|
2733 {
|
34362
|
2734 int offset = p - read_buffer;
|
|
2735 read_buffer = (char *) xrealloc (read_buffer,
|
|
2736 read_buffer_size *= 2);
|
|
2737 p = read_buffer + offset;
|
341
|
2738 end = read_buffer + read_buffer_size;
|
|
2739 }
|
21724
|
2740
|
341
|
2741 if (c == '\\')
|
19240
|
2742 {
|
88383
|
2743 int modifiers;
|
88886
|
2744
|
|
2745 c = read_escape (readcharfun, 1);
|
21724
|
2746
|
|
2747 /* C is -1 if \ newline has just been seen */
|
|
2748 if (c == -1)
|
19240
|
2749 {
|
21724
|
2750 if (p == read_buffer)
|
|
2751 cancel = 1;
|
19240
|
2752 continue;
|
|
2753 }
|
21724
|
2754
|
88383
|
2755 modifiers = c & CHAR_MODIFIER_MASK;
|
|
2756 c = c & ~CHAR_MODIFIER_MASK;
|
|
2757
|
88886
|
2758 if (CHAR_BYTE8_P (c))
|
20669
|
2759 force_singlebyte = 1;
|
88886
|
2760 else if (! ASCII_CHAR_P (c))
|
|
2761 force_multibyte = 1;
|
|
2762 else /* i.e. ASCII_CHAR_P (c) */
|
88383
|
2763 {
|
|
2764 /* Allow `\C- ' and `\C-?'. */
|
|
2765 if (modifiers == CHAR_CTL)
|
|
2766 {
|
|
2767 if (c == ' ')
|
|
2768 c = 0, modifiers = 0;
|
|
2769 else if (c == '?')
|
|
2770 c = 127, modifiers = 0;
|
|
2771 }
|
|
2772 if (modifiers & CHAR_SHIFT)
|
|
2773 {
|
|
2774 /* Shift modifier is valid only with [A-Za-z]. */
|
|
2775 if (c >= 'A' && c <= 'Z')
|
|
2776 modifiers &= ~CHAR_SHIFT;
|
|
2777 else if (c >= 'a' && c <= 'z')
|
|
2778 c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
|
|
2779 }
|
|
2780
|
|
2781 if (modifiers & CHAR_META)
|
|
2782 {
|
|
2783 /* Move the meta bit to the right place for a
|
|
2784 string. */
|
|
2785 modifiers &= ~CHAR_META;
|
|
2786 c = BYTE8_TO_CHAR (c | 0x80);
|
|
2787 force_singlebyte = 1;
|
|
2788 }
|
|
2789 }
|
|
2790
|
|
2791 /* Any modifiers remaining are invalid. */
|
|
2792 if (modifiers)
|
|
2793 error ("Invalid modifier in string");
|
|
2794 p += CHAR_STRING (c, (unsigned char *) p);
|
341
|
2795 }
|
88886
|
2796 else
|
6470
|
2797 {
|
88383
|
2798 p += CHAR_STRING (c, (unsigned char *) p);
|
89453
|
2799 if (CHAR_BYTE8_P (c))
|
|
2800 force_singlebyte = 1;
|
|
2801 else if (! ASCII_CHAR_P (c))
|
42424
|
2802 force_multibyte = 1;
|
19240
|
2803 }
|
43080
|
2804 nchars++;
|
341
|
2805 }
|
43080
|
2806
|
20548
|
2807 if (c < 0)
|
28733
|
2808 end_of_file_error ();
|
341
|
2809
|
|
2810 /* If purifying, and string starts with \ newline,
|
|
2811 return zero instead. This is for doc strings
|
604
|
2812 that we are really going to find in etc/DOC.nn.nn */
|
485
|
2813 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
|
341
|
2814 return make_number (0);
|
|
2815
|
88383
|
2816 if (force_multibyte)
|
|
2817 /* READ_BUFFER already contains valid multibyte forms. */
|
43080
|
2818 ;
|
88383
|
2819 else if (force_singlebyte)
|
21677
|
2820 {
|
88383
|
2821 nchars = str_as_unibyte (read_buffer, p - read_buffer);
|
|
2822 p = read_buffer + nchars;
|
40503
|
2823 }
|
20669
|
2824 else
|
88383
|
2825 /* Otherwise, READ_BUFFER contains only ASCII. */
|
43080
|
2826 ;
|
20669
|
2827
|
45554
|
2828 /* We want readchar_count to be the number of characters, not
|
|
2829 bytes. Hence we adjust for multibyte characters in the
|
|
2830 string. ... But it doesn't seem to be necessary, because
|
|
2831 READCHAR *does* read multibyte characters from buffers. */
|
|
2832 /* readchar_count -= (p - read_buffer) - nchars; */
|
341
|
2833 if (read_pure)
|
21251
|
2834 return make_pure_string (read_buffer, nchars, p - read_buffer,
|
88383
|
2835 (force_multibyte
|
|
2836 || (p - read_buffer != nchars)));
|
21251
|
2837 return make_specified_string (read_buffer, nchars, p - read_buffer,
|
88383
|
2838 (force_multibyte
|
|
2839 || (p - read_buffer != nchars)));
|
341
|
2840 }
|
|
2841
|
762
|
2842 case '.':
|
|
2843 {
|
|
2844 int next_char = READCHAR;
|
|
2845 UNREAD (next_char);
|
|
2846
|
28746
|
2847 if (next_char <= 040
|
50513
|
2848 || (next_char < 0200
|
58093
|
2849 && (index ("\"';([#?", next_char)
|
|
2850 || (!first_in_list && next_char == '`')
|
|
2851 || (new_backquote_flag && next_char == ','))))
|
762
|
2852 {
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2853 *pch = c;
|
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2854 return Qnil;
|
762
|
2855 }
|
|
2856
|
|
2857 /* Otherwise, we fall through! Note that the atom-reading loop
|
|
2858 below will now loop at least once, assuring that we will not
|
|
2859 try to UNREAD two characters in a row. */
|
|
2860 }
|
341
|
2861 default:
|
11683
|
2862 default_label:
|
341
|
2863 if (c <= 040) goto retry;
|
82214
|
2864 if (c == 0x8a0) /* NBSP */
|
|
2865 goto retry;
|
341
|
2866 {
|
31315
|
2867 char *p = read_buffer;
|
5017
|
2868 int quoted = 0;
|
341
|
2869
|
|
2870 {
|
31315
|
2871 char *end = read_buffer + read_buffer_size;
|
341
|
2872
|
20548
|
2873 while (c > 040
|
82214
|
2874 && c != 0x8a0 /* NBSP */
|
50513
|
2875 && (c >= 0200
|
|
2876 || (!index ("\"';()[]#", c)
|
|
2877 && !(!first_in_list && c == '`')
|
|
2878 && !(new_backquote_flag && c == ','))))
|
341
|
2879 {
|
26866
|
2880 if (end - p < MAX_MULTIBYTE_LENGTH)
|
341
|
2881 {
|
34362
|
2882 int offset = p - read_buffer;
|
|
2883 read_buffer = (char *) xrealloc (read_buffer,
|
|
2884 read_buffer_size *= 2);
|
|
2885 p = read_buffer + offset;
|
341
|
2886 end = read_buffer + read_buffer_size;
|
|
2887 }
|
49600
|
2888
|
341
|
2889 if (c == '\\')
|
5017
|
2890 {
|
|
2891 c = READCHAR;
|
34604
|
2892 if (c == -1)
|
|
2893 end_of_file_error ();
|
5017
|
2894 quoted = 1;
|
|
2895 }
|
20548
|
2896
|
91093
|
2897 if (multibyte)
|
26866
|
2898 p += CHAR_STRING (c, p);
|
21724
|
2899 else
|
|
2900 *p++ = c;
|
341
|
2901 c = READCHAR;
|
|
2902 }
|
|
2903
|
|
2904 if (p == end)
|
|
2905 {
|
34362
|
2906 int offset = p - read_buffer;
|
|
2907 read_buffer = (char *) xrealloc (read_buffer,
|
|
2908 read_buffer_size *= 2);
|
|
2909 p = read_buffer + offset;
|
|
2910 end = read_buffer + read_buffer_size;
|
341
|
2911 }
|
|
2912 *p = 0;
|
|
2913 if (c >= 0)
|
|
2914 UNREAD (c);
|
|
2915 }
|
|
2916
|
16141
|
2917 if (!quoted && !uninterned_symbol)
|
5017
|
2918 {
|
|
2919 register char *p1;
|
|
2920 register Lisp_Object val;
|
|
2921 p1 = read_buffer;
|
|
2922 if (*p1 == '+' || *p1 == '-') p1++;
|
|
2923 /* Is it an integer? */
|
|
2924 if (p1 != p)
|
|
2925 {
|
|
2926 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
|
|
2927 /* Integers can have trailing decimal points. */
|
|
2928 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
|
|
2929 if (p1 == p)
|
|
2930 /* It is an integer. */
|
|
2931 {
|
|
2932 if (p1[-1] == '.')
|
|
2933 p1[-1] = '\0';
|
89070
|
2934 /* Fixme: if we have strtol, use that, and check
|
|
2935 for overflow. */
|
11699
|
2936 if (sizeof (int) == sizeof (EMACS_INT))
|
|
2937 XSETINT (val, atoi (read_buffer));
|
|
2938 else if (sizeof (long) == sizeof (EMACS_INT))
|
|
2939 XSETINT (val, atol (read_buffer));
|
|
2940 else
|
|
2941 abort ();
|
5017
|
2942 return val;
|
|
2943 }
|
|
2944 }
|
|
2945 if (isfloat_string (read_buffer))
|
20815
|
2946 {
|
23159
|
2947 /* Compute NaN and infinities using 0.0 in a variable,
|
|
2948 to cope with compilers that think they are smarter
|
23193
|
2949 than we are. */
|
21636
|
2950 double zero = 0.0;
|
23159
|
2951
|
|
2952 double value;
|
|
2953
|
|
2954 /* Negate the value ourselves. This treats 0, NaNs,
|
|
2955 and infinity properly on IEEE floating point hosts,
|
|
2956 and works around a common bug where atof ("-0.0")
|
|
2957 drops the sign. */
|
|
2958 int negative = read_buffer[0] == '-';
|
|
2959
|
|
2960 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
|
20815
|
2961 returns 1, is if the input ends in e+INF or e+NaN. */
|
23159
|
2962 switch (p[-1])
|
20815
|
2963 {
|
23159
|
2964 case 'F':
|
|
2965 value = 1.0 / zero;
|
|
2966 break;
|
|
2967 case 'N':
|
|
2968 value = zero / zero;
|
63755
|
2969
|
|
2970 /* If that made a "negative" NaN, negate it. */
|
|
2971
|
|
2972 {
|
|
2973 int i;
|
|
2974 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
|
|
2975
|
|
2976 u_data.d = value;
|
|
2977 u_minus_zero.d = - 0.0;
|
|
2978 for (i = 0; i < sizeof (double); i++)
|
|
2979 if (u_data.c[i] & u_minus_zero.c[i])
|
|
2980 {
|
|
2981 value = - value;
|
|
2982 break;
|
|
2983 }
|
|
2984 }
|
|
2985 /* Now VALUE is a positive NaN. */
|
23159
|
2986 break;
|
|
2987 default:
|
|
2988 value = atof (read_buffer + negative);
|
|
2989 break;
|
20815
|
2990 }
|
23159
|
2991
|
|
2992 return make_float (negative ? - value : value);
|
20815
|
2993 }
|
5017
|
2994 }
|
45554
|
2995 {
|
91185
|
2996 Lisp_Object name, result;
|
|
2997 EMACS_INT nbytes = p - read_buffer;
|
|
2998 EMACS_INT nchars
|
|
2999 = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
|
|
3000 : nbytes);
|
|
3001
|
|
3002 if (uninterned_symbol && ! NILP (Vpurify_flag))
|
|
3003 name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
|
|
3004 else
|
|
3005 name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
|
|
3006 result = (uninterned_symbol ? Fmake_symbol (name)
|
|
3007 : Fintern (name, Qnil));
|
91093
|
3008
|
45554
|
3009 if (EQ (Vread_with_symbol_positions, Qt)
|
|
3010 || EQ (Vread_with_symbol_positions, readcharfun))
|
49600
|
3011 Vread_symbol_positions_list =
|
45554
|
3012 /* Kind of a hack; this will probably fail if characters
|
|
3013 in the symbol name were escaped. Not really a big
|
|
3014 deal, though. */
|
45747
|
3015 Fcons (Fcons (result,
|
|
3016 make_number (readchar_count
|
|
3017 - XFASTINT (Flength (Fsymbol_name (result))))),
|
45554
|
3018 Vread_symbol_positions_list);
|
|
3019 return result;
|
|
3020 }
|
341
|
3021 }
|
|
3022 }
|
|
3023 }
|
|
3024
|
25165
|
3025
|
|
3026 /* List of nodes we've seen during substitute_object_in_subtree. */
|
|
3027 static Lisp_Object seen_list;
|
|
3028
|
|
3029 static void
|
|
3030 substitute_object_in_subtree (object, placeholder)
|
|
3031 Lisp_Object object;
|
|
3032 Lisp_Object placeholder;
|
|
3033 {
|
|
3034 Lisp_Object check_object;
|
|
3035
|
|
3036 /* We haven't seen any objects when we start. */
|
|
3037 seen_list = Qnil;
|
|
3038
|
|
3039 /* Make all the substitutions. */
|
|
3040 check_object
|
|
3041 = substitute_object_recurse (object, placeholder, object);
|
49600
|
3042
|
25165
|
3043 /* Clear seen_list because we're done with it. */
|
|
3044 seen_list = Qnil;
|
|
3045
|
|
3046 /* The returned object here is expected to always eq the
|
|
3047 original. */
|
|
3048 if (!EQ (check_object, object))
|
|
3049 error ("Unexpected mutation error in reader");
|
|
3050 }
|
|
3051
|
|
3052 /* Feval doesn't get called from here, so no gc protection is needed. */
|
94696
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3053 #define SUBSTITUTE(get_val, set_val) \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3054 do { \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3055 Lisp_Object old_value = get_val; \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3056 Lisp_Object true_value \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3057 = substitute_object_recurse (object, placeholder, \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3058 old_value); \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3059 \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3060 if (!EQ (old_value, true_value)) \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3061 { \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3062 set_val; \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3063 } \
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3064 } while (0)
|
25165
|
3065
|
|
3066 static Lisp_Object
|
|
3067 substitute_object_recurse (object, placeholder, subtree)
|
|
3068 Lisp_Object object;
|
|
3069 Lisp_Object placeholder;
|
|
3070 Lisp_Object subtree;
|
|
3071 {
|
|
3072 /* If we find the placeholder, return the target object. */
|
|
3073 if (EQ (placeholder, subtree))
|
|
3074 return object;
|
|
3075
|
|
3076 /* If we've been to this node before, don't explore it again. */
|
|
3077 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
|
|
3078 return subtree;
|
|
3079
|
|
3080 /* If this node can be the entry point to a cycle, remember that
|
|
3081 we've seen it. It can only be such an entry point if it was made
|
|
3082 by #n=, which means that we can find it as a value in
|
|
3083 read_objects. */
|
|
3084 if (!EQ (Qnil, Frassq (subtree, read_objects)))
|
|
3085 seen_list = Fcons (subtree, seen_list);
|
49600
|
3086
|
25165
|
3087 /* Recurse according to subtree's type.
|
|
3088 Every branch must return a Lisp_Object. */
|
|
3089 switch (XTYPE (subtree))
|
|
3090 {
|
|
3091 case Lisp_Vectorlike:
|
|
3092 {
|
94696
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3093 int i, length = 0;
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3094 if (BOOL_VECTOR_P (subtree))
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3095 return subtree; /* No sub-objects anyway. */
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3096 else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3097 || COMPILEDP (subtree))
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3098 length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3099 else if (VECTORP (subtree))
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3100 length = ASIZE (subtree);
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3101 else
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3102 /* An unknown pseudovector may contain non-Lisp fields, so we
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3103 can't just blindly traverse all its fields. We used to call
|
96361
|
3104 `Flength' which signaled `sequencep', so I just preserved this
|
94696
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3105 behavior. */
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3106 wrong_type_argument (Qsequencep, subtree);
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3107
|
25165
|
3108 for (i = 0; i < length; i++)
|
94696
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3109 SUBSTITUTE (AREF (subtree, i),
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3110 ASET (subtree, i, true_value));
|
25165
|
3111 return subtree;
|
|
3112 }
|
|
3113
|
|
3114 case Lisp_Cons:
|
|
3115 {
|
94696
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3116 SUBSTITUTE (XCAR (subtree),
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3117 XSETCAR (subtree, true_value));
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3118 SUBSTITUTE (XCDR (subtree),
|
c522dff11548
(substitute_object_recurse): Use lower-level primitives.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3119 XSETCDR (subtree, true_value));
|
25165
|
3120 return subtree;
|
|
3121 }
|
|
3122
|
|
3123 case Lisp_String:
|
|
3124 {
|
|
3125 /* Check for text properties in each interval.
|
39808
|
3126 substitute_in_interval contains part of the logic. */
|
25165
|
3127
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3128 INTERVAL root_interval = STRING_INTERVALS (subtree);
|
25165
|
3129 Lisp_Object arg = Fcons (object, placeholder);
|
49600
|
3130
|
39857
6235c0f8e52c
(substitute_object_recurse): Use traverse_intervals_noorder.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3131 traverse_intervals_noorder (root_interval,
|
6235c0f8e52c
(substitute_object_recurse): Use traverse_intervals_noorder.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3132 &substitute_in_interval, arg);
|
25165
|
3133
|
|
3134 return subtree;
|
|
3135 }
|
|
3136
|
|
3137 /* Other types don't recurse any further. */
|
|
3138 default:
|
|
3139 return subtree;
|
|
3140 }
|
|
3141 }
|
|
3142
|
|
3143 /* Helper function for substitute_object_recurse. */
|
|
3144 static void
|
|
3145 substitute_in_interval (interval, arg)
|
|
3146 INTERVAL interval;
|
|
3147 Lisp_Object arg;
|
|
3148 {
|
|
3149 Lisp_Object object = Fcar (arg);
|
|
3150 Lisp_Object placeholder = Fcdr (arg);
|
|
3151
|
|
3152 SUBSTITUTE(interval->plist, interval->plist = true_value);
|
|
3153 }
|
|
3154
|
|
3155
|
341
|
3156 #define LEAD_INT 1
|
|
3157 #define DOT_CHAR 2
|
|
3158 #define TRAIL_INT 4
|
|
3159 #define E_CHAR 8
|
|
3160 #define EXP_INT 16
|
|
3161
|
|
3162 int
|
|
3163 isfloat_string (cp)
|
|
3164 register char *cp;
|
|
3165 {
|
21799
|
3166 register int state;
|
49600
|
3167
|
21911
|
3168 char *start = cp;
|
|
3169
|
341
|
3170 state = 0;
|
|
3171 if (*cp == '+' || *cp == '-')
|
|
3172 cp++;
|
|
3173
|
9871
|
3174 if (*cp >= '0' && *cp <= '9')
|
341
|
3175 {
|
|
3176 state |= LEAD_INT;
|
9871
|
3177 while (*cp >= '0' && *cp <= '9')
|
|
3178 cp++;
|
341
|
3179 }
|
|
3180 if (*cp == '.')
|
|
3181 {
|
|
3182 state |= DOT_CHAR;
|
|
3183 cp++;
|
|
3184 }
|
9871
|
3185 if (*cp >= '0' && *cp <= '9')
|
341
|
3186 {
|
|
3187 state |= TRAIL_INT;
|
9871
|
3188 while (*cp >= '0' && *cp <= '9')
|
341
|
3189 cp++;
|
|
3190 }
|
16342
|
3191 if (*cp == 'e' || *cp == 'E')
|
341
|
3192 {
|
|
3193 state |= E_CHAR;
|
|
3194 cp++;
|
11735
|
3195 if (*cp == '+' || *cp == '-')
|
|
3196 cp++;
|
341
|
3197 }
|
|
3198
|
9871
|
3199 if (*cp >= '0' && *cp <= '9')
|
341
|
3200 {
|
|
3201 state |= EXP_INT;
|
9871
|
3202 while (*cp >= '0' && *cp <= '9')
|
341
|
3203 cp++;
|
|
3204 }
|
21911
|
3205 else if (cp == start)
|
|
3206 ;
|
20815
|
3207 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
|
|
3208 {
|
|
3209 state |= EXP_INT;
|
|
3210 cp += 3;
|
|
3211 }
|
|
3212 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
|
|
3213 {
|
|
3214 state |= EXP_INT;
|
|
3215 cp += 3;
|
|
3216 }
|
|
3217
|
11172
|
3218 return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
|
341
|
3219 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
|
826
|
3220 || state == (DOT_CHAR|TRAIL_INT)
|
341
|
3221 || state == (LEAD_INT|E_CHAR|EXP_INT)
|
826
|
3222 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
|
|
3223 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
|
341
|
3224 }
|
27727
|
3225
|
341
|
3226
|
|
3227 static Lisp_Object
|
22321
|
3228 read_vector (readcharfun, bytecodeflag)
|
341
|
3229 Lisp_Object readcharfun;
|
22321
|
3230 int bytecodeflag;
|
341
|
3231 {
|
|
3232 register int i;
|
|
3233 register int size;
|
|
3234 register Lisp_Object *ptr;
|
22321
|
3235 register Lisp_Object tem, item, vector;
|
341
|
3236 register struct Lisp_Cons *otem;
|
|
3237 Lisp_Object len;
|
|
3238
|
|
3239 tem = read_list (1, readcharfun);
|
|
3240 len = Flength (tem);
|
|
3241 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
|
|
3242
|
|
3243 size = XVECTOR (vector)->size;
|
|
3244 ptr = XVECTOR (vector)->contents;
|
|
3245 for (i = 0; i < size; i++)
|
|
3246 {
|
22321
|
3247 item = Fcar (tem);
|
|
3248 /* If `load-force-doc-strings' is t when reading a lazily-loaded
|
|
3249 bytecode object, the docstring containing the bytecode and
|
|
3250 constants values must be treated as unibyte and passed to
|
|
3251 Fread, to get the actual bytecode string and constants vector. */
|
|
3252 if (bytecodeflag && load_force_doc_strings)
|
|
3253 {
|
|
3254 if (i == COMPILED_BYTECODE)
|
|
3255 {
|
|
3256 if (!STRINGP (item))
|
63699
|
3257 error ("Invalid byte code");
|
22321
|
3258
|
|
3259 /* Delay handling the bytecode slot until we know whether
|
|
3260 it is lazily-loaded (we can tell by whether the
|
|
3261 constants slot is nil). */
|
|
3262 ptr[COMPILED_CONSTANTS] = item;
|
|
3263 item = Qnil;
|
|
3264 }
|
|
3265 else if (i == COMPILED_CONSTANTS)
|
|
3266 {
|
|
3267 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
|
|
3268
|
|
3269 if (NILP (item))
|
|
3270 {
|
|
3271 /* Coerce string to unibyte (like string-as-unibyte,
|
|
3272 but without generating extra garbage and
|
|
3273 guaranteeing no change in the contents). */
|
46375
|
3274 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3275 STRING_SET_UNIBYTE (bytestr);
|
22321
|
3276
|
88886
|
3277 item = Fread (Fcons (bytestr, readcharfun));
|
22321
|
3278 if (!CONSP (item))
|
63699
|
3279 error ("Invalid byte code");
|
22321
|
3280
|
|
3281 otem = XCONS (item);
|
25663
|
3282 bytestr = XCAR (item);
|
|
3283 item = XCDR (item);
|
22321
|
3284 free_cons (otem);
|
|
3285 }
|
|
3286
|
|
3287 /* Now handle the bytecode slot. */
|
|
3288 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
|
|
3289 }
|
88886
|
3290 else if (i == COMPILED_DOC_STRING
|
|
3291 && STRINGP (item)
|
|
3292 && ! STRING_MULTIBYTE (item))
|
|
3293 {
|
|
3294 if (EQ (readcharfun, Qget_emacs_mule_file_char))
|
|
3295 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
|
|
3296 else
|
|
3297 item = Fstring_as_multibyte (item);
|
|
3298 }
|
22321
|
3299 }
|
|
3300 ptr[i] = read_pure ? Fpurecopy (item) : item;
|
341
|
3301 otem = XCONS (tem);
|
|
3302 tem = Fcdr (tem);
|
|
3303 free_cons (otem);
|
|
3304 }
|
|
3305 return vector;
|
|
3306 }
|
49600
|
3307
|
20548
|
3308 /* FLAG = 1 means check for ] to terminate rather than ) and .
|
|
3309 FLAG = -1 means check for starting with defun
|
341
|
3310 and make structure pure. */
|
|
3311
|
|
3312 static Lisp_Object
|
|
3313 read_list (flag, readcharfun)
|
|
3314 int flag;
|
|
3315 register Lisp_Object readcharfun;
|
|
3316 {
|
|
3317 /* -1 means check next element for defun,
|
|
3318 0 means don't check,
|
|
3319 1 means already checked and found defun. */
|
|
3320 int defunflag = flag < 0 ? -1 : 0;
|
|
3321 Lisp_Object val, tail;
|
|
3322 register Lisp_Object elt, tem;
|
|
3323 struct gcpro gcpro1, gcpro2;
|
12639
|
3324 /* 0 is the normal case.
|
12780
|
3325 1 means this list is a doc reference; replace it with the number 0.
|
49600
|
3326 2 means this list is a doc reference; replace it with the doc string. */
|
12639
|
3327 int doc_reference = 0;
|
341
|
3328
|
11683
|
3329 /* Initialize this to 1 if we are reading a list. */
|
|
3330 int first_in_list = flag <= 0;
|
|
3331
|
341
|
3332 val = Qnil;
|
|
3333 tail = Qnil;
|
|
3334
|
|
3335 while (1)
|
|
3336 {
|
20609
|
3337 int ch;
|
341
|
3338 GCPRO2 (val, tail);
|
11683
|
3339 elt = read1 (readcharfun, &ch, first_in_list);
|
341
|
3340 UNGCPRO;
|
10200
|
3341
|
11683
|
3342 first_in_list = 0;
|
|
3343
|
12639
|
3344 /* While building, if the list starts with #$, treat it specially. */
|
10200
|
3345 if (EQ (elt, Vload_file_name)
|
20048
|
3346 && ! NILP (elt)
|
12639
|
3347 && !NILP (Vpurify_flag))
|
|
3348 {
|
|
3349 if (NILP (Vdoc_file_name))
|
|
3350 /* We have not yet called Snarf-documentation, so assume
|
|
3351 this file is described in the DOC-MM.NN file
|
|
3352 and Snarf-documentation will fill in the right value later.
|
|
3353 For now, replace the whole list with 0. */
|
|
3354 doc_reference = 1;
|
|
3355 else
|
|
3356 /* We have already called Snarf-documentation, so make a relative
|
|
3357 file name for this file, so it can be found properly
|
|
3358 in the installed Lisp directory.
|
|
3359 We don't use Fexpand_file_name because that would make
|
|
3360 the directory absolute now. */
|
|
3361 elt = concat2 (build_string ("../lisp/"),
|
|
3362 Ffile_name_nondirectory (elt));
|
|
3363 }
|
12780
|
3364 else if (EQ (elt, Vload_file_name)
|
20048
|
3365 && ! NILP (elt)
|
12780
|
3366 && load_force_doc_strings)
|
|
3367 doc_reference = 2;
|
10200
|
3368
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3369 if (ch)
|
341
|
3370 {
|
|
3371 if (flag > 0)
|
|
3372 {
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3373 if (ch == ']')
|
341
|
3374 return val;
|
71984
|
3375 invalid_syntax (") or . in a vector", 18);
|
341
|
3376 }
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3377 if (ch == ')')
|
341
|
3378 return val;
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3379 if (ch == '.')
|
341
|
3380 {
|
|
3381 GCPRO2 (val, tail);
|
485
|
3382 if (!NILP (tail))
|
40690
ba7239b8872e
(Fload): Use XSETCARFASTINT, XSETCDRFASTINT instead of treating XCAR and XCDR
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3383 XSETCDR (tail, read0 (readcharfun));
|
341
|
3384 else
|
|
3385 val = read0 (readcharfun);
|
11683
|
3386 read1 (readcharfun, &ch, 0);
|
341
|
3387 UNGCPRO;
|
9358
361c6409e7c1
(read1): New argument for returning out-of-band data, obviating the need for
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3388 if (ch == ')')
|
12639
|
3389 {
|
|
3390 if (doc_reference == 1)
|
|
3391 return make_number (0);
|
12780
|
3392 if (doc_reference == 2)
|
|
3393 {
|
|
3394 /* Get a doc string from the file we are loading.
|
88886
|
3395 If it's in saved_doc_string, get it from there.
|
|
3396
|
|
3397 Here, we don't know if the string is a
|
|
3398 bytecode string or a doc string. As a
|
|
3399 bytecode string must be unibyte, we always
|
|
3400 return a unibyte string. If it is actually a
|
|
3401 doc string, caller must make it
|
|
3402 multibyte. */
|
89483
|
3403
|
25663
|
3404 int pos = XINT (XCDR (val));
|
22321
|
3405 /* Position is negative for user variables. */
|
|
3406 if (pos < 0) pos = -pos;
|
12780
|
3407 if (pos >= saved_doc_string_position
|
|
3408 && pos < (saved_doc_string_position
|
|
3409 + saved_doc_string_length))
|
|
3410 {
|
|
3411 int start = pos - saved_doc_string_position;
|
|
3412 int from, to;
|
|
3413
|
|
3414 /* Process quoting with ^A,
|
|
3415 and find the end of the string,
|
|
3416 which is marked with ^_ (037). */
|
|
3417 for (from = start, to = start;
|
|
3418 saved_doc_string[from] != 037;)
|
|
3419 {
|
|
3420 int c = saved_doc_string[from++];
|
|
3421 if (c == 1)
|
|
3422 {
|
|
3423 c = saved_doc_string[from++];
|
|
3424 if (c == 1)
|
|
3425 saved_doc_string[to++] = c;
|
|
3426 else if (c == '0')
|
|
3427 saved_doc_string[to++] = 0;
|
|
3428 else if (c == '_')
|
|
3429 saved_doc_string[to++] = 037;
|
|
3430 }
|
|
3431 else
|
|
3432 saved_doc_string[to++] = c;
|
|
3433 }
|
|
3434
|
88886
|
3435 return make_unibyte_string (saved_doc_string + start,
|
|
3436 to - start);
|
12780
|
3437 }
|
22321
|
3438 /* Look in prev_saved_doc_string the same way. */
|
|
3439 else if (pos >= prev_saved_doc_string_position
|
|
3440 && pos < (prev_saved_doc_string_position
|
|
3441 + prev_saved_doc_string_length))
|
|
3442 {
|
|
3443 int start = pos - prev_saved_doc_string_position;
|
|
3444 int from, to;
|
|
3445
|
|
3446 /* Process quoting with ^A,
|
|
3447 and find the end of the string,
|
|
3448 which is marked with ^_ (037). */
|
|
3449 for (from = start, to = start;
|
|
3450 prev_saved_doc_string[from] != 037;)
|
|
3451 {
|
|
3452 int c = prev_saved_doc_string[from++];
|
|
3453 if (c == 1)
|
|
3454 {
|
|
3455 c = prev_saved_doc_string[from++];
|
|
3456 if (c == 1)
|
|
3457 prev_saved_doc_string[to++] = c;
|
|
3458 else if (c == '0')
|
|
3459 prev_saved_doc_string[to++] = 0;
|
|
3460 else if (c == '_')
|
|
3461 prev_saved_doc_string[to++] = 037;
|
|
3462 }
|
|
3463 else
|
|
3464 prev_saved_doc_string[to++] = c;
|
|
3465 }
|
|
3466
|
88886
|
3467 return make_unibyte_string (prev_saved_doc_string
|
|
3468 + start,
|
|
3469 to - start);
|
22321
|
3470 }
|
12780
|
3471 else
|
88886
|
3472 return get_doc_string (val, 1, 0);
|
12780
|
3473 }
|
|
3474
|
12639
|
3475 return val;
|
|
3476 }
|
71984
|
3477 invalid_syntax (". in wrong context", 18);
|
341
|
3478 }
|
71984
|
3479 invalid_syntax ("] in a list", 11);
|
341
|
3480 }
|
|
3481 tem = (read_pure && flag <= 0
|
|
3482 ? pure_cons (elt, Qnil)
|
|
3483 : Fcons (elt, Qnil));
|
485
|
3484 if (!NILP (tail))
|
40690
ba7239b8872e
(Fload): Use XSETCARFASTINT, XSETCDRFASTINT instead of treating XCAR and XCDR
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3485 XSETCDR (tail, tem);
|
341
|
3486 else
|
|
3487 val = tem;
|
|
3488 tail = tem;
|
|
3489 if (defunflag < 0)
|
|
3490 defunflag = EQ (elt, Qdefun);
|
|
3491 else if (defunflag > 0)
|
|
3492 read_pure = 1;
|
|
3493 }
|
|
3494 }
|
|
3495
|
|
3496 Lisp_Object Vobarray;
|
|
3497 Lisp_Object initial_obarray;
|
|
3498
|
11188
|
3499 /* oblookup stores the bucket number here, for the sake of Funintern. */
|
|
3500
|
|
3501 int oblookup_last_bucket_number;
|
|
3502
|
|
3503 static int hash_string ();
|
|
3504
|
|
3505 /* Get an error if OBARRAY is not an obarray.
|
|
3506 If it is one, return it. */
|
|
3507
|
341
|
3508 Lisp_Object
|
|
3509 check_obarray (obarray)
|
|
3510 Lisp_Object obarray;
|
|
3511 {
|
71837
|
3512 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
|
341
|
3513 {
|
|
3514 /* If Vobarray is now invalid, force it to be valid. */
|
|
3515 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
|
71837
|
3516 wrong_type_argument (Qvectorp, obarray);
|
341
|
3517 }
|
|
3518 return obarray;
|
|
3519 }
|
|
3520
|
11188
|
3521 /* Intern the C string STR: return a symbol with that name,
|
|
3522 interned in the current obarray. */
|
341
|
3523
|
|
3524 Lisp_Object
|
|
3525 intern (str)
|
46472
|
3526 const char *str;
|
341
|
3527 {
|
|
3528 Lisp_Object tem;
|
|
3529 int len = strlen (str);
|
6503
7c566d0e4b3d
(read_filtered_event, intern): Use assignment instead of initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3530 Lisp_Object obarray;
|
341
|
3531
|
6503
7c566d0e4b3d
(read_filtered_event, intern): Use assignment instead of initialization.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3532 obarray = Vobarray;
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3533 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
|
341
|
3534 obarray = check_obarray (obarray);
|
20609
|
3535 tem = oblookup (obarray, str, len, len);
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3536 if (SYMBOLP (tem))
|
341
|
3537 return tem;
|
18051
b985b9739beb
(intern): Don't make a pure string here, since Fintern does that.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3538 return Fintern (make_string (str, len), obarray);
|
341
|
3539 }
|
16141
|
3540
|
|
3541 /* Create an uninterned symbol with name STR. */
|
|
3542
|
|
3543 Lisp_Object
|
|
3544 make_symbol (str)
|
|
3545 char *str;
|
|
3546 {
|
|
3547 int len = strlen (str);
|
|
3548
|
|
3549 return Fmake_symbol ((!NILP (Vpurify_flag)
|
21251
|
3550 ? make_pure_string (str, len, len, 0)
|
16141
|
3551 : make_string (str, len)));
|
|
3552 }
|
11188
|
3553
|
341
|
3554 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3555 doc: /* Return the canonical symbol whose name is STRING.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3556 If there is none, one is created by this function and returned.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3557 A second optional argument specifies the obarray to use;
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3558 it defaults to the value of `obarray'. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3559 (string, obarray)
|
14092
279f5f3528a8
(Feval_buffer, Feval_region, Fintern, Fintern_soft): Harmonize arguments
Erik Naggum <erik@naggum.no>
diff
changeset
|
3560 Lisp_Object string, obarray;
|
341
|
3561 {
|
|
3562 register Lisp_Object tem, sym, *ptr;
|
|
3563
|
485
|
3564 if (NILP (obarray)) obarray = Vobarray;
|
341
|
3565 obarray = check_obarray (obarray);
|
|
3566
|
40656
|
3567 CHECK_STRING (string);
|
341
|
3568
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3569 tem = oblookup (obarray, SDATA (string),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3570 SCHARS (string),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3571 SBYTES (string));
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3572 if (!INTEGERP (tem))
|
341
|
3573 return tem;
|
|
3574
|
485
|
3575 if (!NILP (Vpurify_flag))
|
14092
279f5f3528a8
(Feval_buffer, Feval_region, Fintern, Fintern_soft): Harmonize arguments
Erik Naggum <erik@naggum.no>
diff
changeset
|
3576 string = Fpurecopy (string);
|
279f5f3528a8
(Feval_buffer, Feval_region, Fintern, Fintern_soft): Harmonize arguments
Erik Naggum <erik@naggum.no>
diff
changeset
|
3577 sym = Fmake_symbol (string);
|
39580
|
3578
|
|
3579 if (EQ (obarray, initial_obarray))
|
|
3580 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
|
|
3581 else
|
|
3582 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
|
341
|
3583
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3584 if ((SREF (string, 0) == ':')
|
21982
|
3585 && EQ (obarray, initial_obarray))
|
39580
|
3586 {
|
|
3587 XSYMBOL (sym)->constant = 1;
|
|
3588 XSYMBOL (sym)->value = sym;
|
|
3589 }
|
17918
|
3590
|
341
|
3591 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3592 if (SYMBOLP (*ptr))
|
341
|
3593 XSYMBOL (sym)->next = XSYMBOL (*ptr);
|
|
3594 else
|
|
3595 XSYMBOL (sym)->next = 0;
|
|
3596 *ptr = sym;
|
|
3597 return sym;
|
|
3598 }
|
|
3599
|
|
3600 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3601 doc: /* Return the canonical symbol named NAME, or nil if none exists.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3602 NAME may be a string or a symbol. If it is a symbol, that exact
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3603 symbol is searched for.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3604 A second optional argument specifies the obarray to use;
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3605 it defaults to the value of `obarray'. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3606 (name, obarray)
|
26735
|
3607 Lisp_Object name, obarray;
|
341
|
3608 {
|
46446
34f82dbd015b
(Fintern_soft): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3609 register Lisp_Object tem, string;
|
341
|
3610
|
485
|
3611 if (NILP (obarray)) obarray = Vobarray;
|
341
|
3612 obarray = check_obarray (obarray);
|
|
3613
|
26735
|
3614 if (!SYMBOLP (name))
|
|
3615 {
|
40656
|
3616 CHECK_STRING (name);
|
46446
34f82dbd015b
(Fintern_soft): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3617 string = name;
|
26735
|
3618 }
|
|
3619 else
|
46446
34f82dbd015b
(Fintern_soft): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3620 string = SYMBOL_NAME (name);
|
34f82dbd015b
(Fintern_soft): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3621
|
34f82dbd015b
(Fintern_soft): Use string macros instead of Lisp_String fields.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3622 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
|
26735
|
3623 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
|
|
3624 return Qnil;
|
|
3625 else
|
341
|
3626 return tem;
|
|
3627 }
|
11188
|
3628
|
|
3629 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3630 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3631 The value is t if a symbol was found and deleted, nil otherwise.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3632 NAME may be a string or a symbol. If it is a symbol, that symbol
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3633 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3634 OBARRAY defaults to the value of the variable `obarray'. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3635 (name, obarray)
|
11188
|
3636 Lisp_Object name, obarray;
|
|
3637 {
|
|
3638 register Lisp_Object string, tem;
|
|
3639 int hash;
|
|
3640
|
|
3641 if (NILP (obarray)) obarray = Vobarray;
|
|
3642 obarray = check_obarray (obarray);
|
|
3643
|
|
3644 if (SYMBOLP (name))
|
45406
6f19e244af49
* lread.c (Fintern_soft, oblookup): Use SYMBOL_NAME and XSTRING
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3645 string = SYMBOL_NAME (name);
|
11188
|
3646 else
|
|
3647 {
|
40656
|
3648 CHECK_STRING (name);
|
11188
|
3649 string = name;
|
|
3650 }
|
|
3651
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3652 tem = oblookup (obarray, SDATA (string),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3653 SCHARS (string),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3654 SBYTES (string));
|
11188
|
3655 if (INTEGERP (tem))
|
|
3656 return Qnil;
|
|
3657 /* If arg was a symbol, don't delete anything but that symbol itself. */
|
|
3658 if (SYMBOLP (name) && !EQ (name, tem))
|
|
3659 return Qnil;
|
|
3660
|
39580
|
3661 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
|
|
3662 XSYMBOL (tem)->constant = 0;
|
|
3663 XSYMBOL (tem)->indirect_variable = 0;
|
20773
|
3664
|
11188
|
3665 hash = oblookup_last_bucket_number;
|
|
3666
|
|
3667 if (EQ (XVECTOR (obarray)->contents[hash], tem))
|
12780
|
3668 {
|
|
3669 if (XSYMBOL (tem)->next)
|
|
3670 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
|
|
3671 else
|
|
3672 XSETINT (XVECTOR (obarray)->contents[hash], 0);
|
|
3673 }
|
11188
|
3674 else
|
|
3675 {
|
|
3676 Lisp_Object tail, following;
|
|
3677
|
|
3678 for (tail = XVECTOR (obarray)->contents[hash];
|
|
3679 XSYMBOL (tail)->next;
|
|
3680 tail = following)
|
|
3681 {
|
|
3682 XSETSYMBOL (following, XSYMBOL (tail)->next);
|
|
3683 if (EQ (following, tem))
|
|
3684 {
|
|
3685 XSYMBOL (tail)->next = XSYMBOL (following)->next;
|
|
3686 break;
|
|
3687 }
|
|
3688 }
|
|
3689 }
|
|
3690
|
|
3691 return Qt;
|
|
3692 }
|
|
3693
|
|
3694 /* Return the symbol in OBARRAY whose names matches the string
|
20609
|
3695 of SIZE characters (SIZE_BYTE bytes) at PTR.
|
|
3696 If there is no such symbol in OBARRAY, return nil.
|
11188
|
3697
|
|
3698 Also store the bucket number in oblookup_last_bucket_number. */
|
341
|
3699
|
|
3700 Lisp_Object
|
20609
|
3701 oblookup (obarray, ptr, size, size_byte)
|
341
|
3702 Lisp_Object obarray;
|
46472
|
3703 register const char *ptr;
|
20609
|
3704 int size, size_byte;
|
341
|
3705 {
|
8828
|
3706 int hash;
|
|
3707 int obsize;
|
341
|
3708 register Lisp_Object tail;
|
|
3709 Lisp_Object bucket, tem;
|
|
3710
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3711 if (!VECTORP (obarray)
|
5243
|
3712 || (obsize = XVECTOR (obarray)->size) == 0)
|
341
|
3713 {
|
|
3714 obarray = check_obarray (obarray);
|
|
3715 obsize = XVECTOR (obarray)->size;
|
|
3716 }
|
13455
|
3717 /* This is sometimes needed in the middle of GC. */
|
|
3718 obsize &= ~ARRAY_MARK_FLAG;
|
97142
|
3719 hash = hash_string (ptr, size_byte) % obsize;
|
341
|
3720 bucket = XVECTOR (obarray)->contents[hash];
|
11188
|
3721 oblookup_last_bucket_number = hash;
|
58449
|
3722 if (EQ (bucket, make_number (0)))
|
341
|
3723 ;
|
9149
fe6b30db719d
(readchar, readchar, unreadchar, read_filtered_event, Fread, read0, read1,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3724 else if (!SYMBOLP (bucket))
|
341
|
3725 error ("Bad data in guts of obarray"); /* Like CADR error message */
|
11188
|
3726 else
|
|
3727 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
|
341
|
3728 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3729 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3730 && SCHARS (SYMBOL_NAME (tail)) == size
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3731 && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
|
341
|
3732 return tail;
|
|
3733 else if (XSYMBOL (tail)->next == 0)
|
|
3734 break;
|
|
3735 }
|
9274
5c66d8b65a7c
(Fget_file_char, Fload, read1, oblookup, map_obarray, defsubr, defalias,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3736 XSETINT (tem, hash);
|
341
|
3737 return tem;
|
|
3738 }
|
|
3739
|
|
3740 static int
|
|
3741 hash_string (ptr, len)
|
46472
|
3742 const unsigned char *ptr;
|
341
|
3743 int len;
|
|
3744 {
|
46472
|
3745 register const unsigned char *p = ptr;
|
|
3746 register const unsigned char *end = p + len;
|
341
|
3747 register unsigned char c;
|
|
3748 register int hash = 0;
|
|
3749
|
|
3750 while (p != end)
|
|
3751 {
|
|
3752 c = *p++;
|
|
3753 if (c >= 0140) c -= 40;
|
|
3754 hash = ((hash<<3) + (hash>>28) + c);
|
|
3755 }
|
|
3756 return hash & 07777777777;
|
|
3757 }
|
11188
|
3758
|
341
|
3759 void
|
|
3760 map_obarray (obarray, fn, arg)
|
|
3761 Lisp_Object obarray;
|
20298
|
3762 void (*fn) P_ ((Lisp_Object, Lisp_Object));
|
341
|
3763 Lisp_Object arg;
|
|
3764 {
|
|
3765 register int i;
|
|
3766 register Lisp_Object tail;
|
40656
|
3767 CHECK_VECTOR (obarray);
|
341
|
3768 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
|
|
3769 {
|
|
3770 tail = XVECTOR (obarray)->contents[i];
|
19020
1ee295d0114a
(map_obarray): Don't crash if something strange is in the obarray.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3771 if (SYMBOLP (tail))
|
341
|
3772 while (1)
|
|
3773 {
|
|
3774 (*fn) (tail, arg);
|
|
3775 if (XSYMBOL (tail)->next == 0)
|
|
3776 break;
|
9274
5c66d8b65a7c
(Fget_file_char, Fload, read1, oblookup, map_obarray, defsubr, defalias,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3777 XSETSYMBOL (tail, XSYMBOL (tail)->next);
|
341
|
3778 }
|
|
3779 }
|
|
3780 }
|
|
3781
|
20298
|
3782 void
|
341
|
3783 mapatoms_1 (sym, function)
|
|
3784 Lisp_Object sym, function;
|
|
3785 {
|
|
3786 call1 (function, sym);
|
|
3787 }
|
|
3788
|
|
3789 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3790 doc: /* Call FUNCTION on every symbol in OBARRAY.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3791 OBARRAY defaults to the value of `obarray'. */)
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
3792 (function, obarray)
|
341
|
3793 Lisp_Object function, obarray;
|
|
3794 {
|
485
|
3795 if (NILP (obarray)) obarray = Vobarray;
|
341
|
3796 obarray = check_obarray (obarray);
|
|
3797
|
|
3798 map_obarray (obarray, mapatoms_1, function);
|
|
3799 return Qnil;
|
|
3800 }
|
|
3801
|
5117
|
3802 #define OBARRAY_SIZE 1511
|
341
|
3803
|
|
3804 void
|
|
3805 init_obarray ()
|
|
3806 {
|
|
3807 Lisp_Object oblength;
|
|
3808 int hash;
|
|
3809 Lisp_Object *tem;
|
|
3810
|
9313
|
3811 XSETFASTINT (oblength, OBARRAY_SIZE);
|
341
|
3812
|
21251
|
3813 Qnil = Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
|
341
|
3814 Vobarray = Fmake_vector (oblength, make_number (0));
|
|
3815 initial_obarray = Vobarray;
|
|
3816 staticpro (&initial_obarray);
|
|
3817 /* Intern nil in the obarray */
|
39580
|
3818 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
|
|
3819 XSYMBOL (Qnil)->constant = 1;
|
49600
|
3820
|
341
|
3821 /* These locals are to kludge around a pyramid compiler bug. */
|
|
3822 hash = hash_string ("nil", 3);
|
|
3823 /* Separate statement here to avoid VAXC bug. */
|
|
3824 hash %= OBARRAY_SIZE;
|
|
3825 tem = &XVECTOR (Vobarray)->contents[hash];
|
|
3826 *tem = Qnil;
|
|
3827
|
21251
|
3828 Qunbound = Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
|
341
|
3829 XSYMBOL (Qnil)->function = Qunbound;
|
|
3830 XSYMBOL (Qunbound)->value = Qunbound;
|
|
3831 XSYMBOL (Qunbound)->function = Qunbound;
|
|
3832
|
|
3833 Qt = intern ("t");
|
|
3834 XSYMBOL (Qnil)->value = Qnil;
|
|
3835 XSYMBOL (Qnil)->plist = Qnil;
|
|
3836 XSYMBOL (Qt)->value = Qt;
|
39580
|
3837 XSYMBOL (Qt)->constant = 1;
|
341
|
3838
|
|
3839 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
|
|
3840 Vpurify_flag = Qt;
|
|
3841
|
|
3842 Qvariable_documentation = intern ("variable-documentation");
|
16228
|
3843 staticpro (&Qvariable_documentation);
|
341
|
3844
|
26866
|
3845 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
|
27852
|
3846 read_buffer = (char *) xmalloc (read_buffer_size);
|
341
|
3847 }
|
|
3848
|
|
3849 void
|
|
3850 defsubr (sname)
|
|
3851 struct Lisp_Subr *sname;
|
|
3852 {
|
|
3853 Lisp_Object sym;
|
|
3854 sym = intern (sname->symbol_name);
|
85015
|
3855 XSETPVECTYPE (sname, PVEC_SUBR);
|
9274
5c66d8b65a7c
(Fget_file_char, Fload, read1, oblookup, map_obarray, defsubr, defalias,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3856 XSETSUBR (XSYMBOL (sym)->function, sname);
|
341
|
3857 }
|
|
3858
|
|
3859 #ifdef NOTDEF /* use fset in subr.el now */
|
|
3860 void
|
|
3861 defalias (sname, string)
|
|
3862 struct Lisp_Subr *sname;
|
|
3863 char *string;
|
|
3864 {
|
|
3865 Lisp_Object sym;
|
|
3866 sym = intern (string);
|
9274
5c66d8b65a7c
(Fget_file_char, Fload, read1, oblookup, map_obarray, defsubr, defalias,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3867 XSETSUBR (XSYMBOL (sym)->function, sname);
|
341
|
3868 }
|
|
3869 #endif /* NOTDEF */
|
|
3870
|
|
3871 /* Define an "integer variable"; a symbol whose value is forwarded
|
85127
|
3872 to a C variable of type int. Sample call:
|
|
3873 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
|
341
|
3874 void
|
7765
|
3875 defvar_int (namestring, address)
|
341
|
3876 char *namestring;
|
43713
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3877 EMACS_INT *address;
|
341
|
3878 {
|
9466
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3879 Lisp_Object sym, val;
|
341
|
3880 sym = intern (namestring);
|
9466
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3881 val = allocate_misc ();
|
11242
|
3882 XMISCTYPE (val) = Lisp_Misc_Intfwd;
|
9913
c921977bb0ce
(defvar_int, defvar_bool, defvar_lisp_nopro, defvar_per_buffer): Use accessor
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3883 XINTFWD (val)->intvar = address;
|
39580
|
3884 SET_SYMBOL_VALUE (sym, val);
|
341
|
3885 }
|
|
3886
|
42206
|
3887 /* Similar but define a variable whose value is t if address contains 1,
|
85127
|
3888 nil if address contains 0. */
|
341
|
3889 void
|
7765
|
3890 defvar_bool (namestring, address)
|
341
|
3891 char *namestring;
|
|
3892 int *address;
|
|
3893 {
|
9466
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3894 Lisp_Object sym, val;
|
341
|
3895 sym = intern (namestring);
|
9466
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3896 val = allocate_misc ();
|
11242
|
3897 XMISCTYPE (val) = Lisp_Misc_Boolfwd;
|
9913
c921977bb0ce
(defvar_int, defvar_bool, defvar_lisp_nopro, defvar_per_buffer): Use accessor
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3898 XBOOLFWD (val)->boolvar = address;
|
39580
|
3899 SET_SYMBOL_VALUE (sym, val);
|
25555
|
3900 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
|
341
|
3901 }
|
|
3902
|
9466
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3903 /* Similar but define a variable whose value is the Lisp Object stored
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3904 at address. Two versions: with and without gc-marking of the C
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3905 variable. The nopro version is used when that variable will be
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3906 gc-marked for some other reason, since marking the same slot twice
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3907 can cause trouble with strings. */
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3908 void
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3909 defvar_lisp_nopro (namestring, address)
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3910 char *namestring;
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3911 Lisp_Object *address;
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3912 {
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3913 Lisp_Object sym, val;
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3914 sym = intern (namestring);
|
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3915 val = allocate_misc ();
|
11242
|
3916 XMISCTYPE (val) = Lisp_Misc_Objfwd;
|
9913
c921977bb0ce
(defvar_int, defvar_bool, defvar_lisp_nopro, defvar_per_buffer): Use accessor
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3917 XOBJFWD (val)->objvar = address;
|
39580
|
3918 SET_SYMBOL_VALUE (sym, val);
|
9466
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3919 }
|
341
|
3920
|
|
3921 void
|
7765
|
3922 defvar_lisp (namestring, address)
|
341
|
3923 char *namestring;
|
|
3924 Lisp_Object *address;
|
|
3925 {
|
9466
9052bf69f7de
(defvar_int, defvar_bool, defvar_lisp, defvar_lisp_nopro, defvar_per_buffer):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3926 defvar_lisp_nopro (namestring, address);
|
341
|
3927 staticpro (address);
|
|
3928 }
|
|
3929
|
10606
|
3930 /* Similar but define a variable whose value is the Lisp Object stored
|
11020
|
3931 at a particular offset in the current kboard object. */
|
10606
|
3932
|
|
3933 void
|
11020
|
3934 defvar_kboard (namestring, offset)
|
10606
|
3935 char *namestring;
|
|
3936 int offset;
|
|
3937 {
|
|
3938 Lisp_Object sym, val;
|
|
3939 sym = intern (namestring);
|
|
3940 val = allocate_misc ();
|
11242
|
3941 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd;
|
11020
|
3942 XKBOARD_OBJFWD (val)->offset = offset;
|
39580
|
3943 SET_SYMBOL_VALUE (sym, val);
|
10606
|
3944 }
|
341
|
3945
|
14130
|
3946 /* Record the value of load-path used at the start of dumping
|
|
3947 so we can see if the site changed it later during dumping. */
|
|
3948 static Lisp_Object dump_path;
|
|
3949
|
20298
|
3950 void
|
364
|
3951 init_lread ()
|
341
|
3952 {
|
617
|
3953 char *normal;
|
11735
|
3954 int turn_off_warning = 0;
|
341
|
3955
|
364
|
3956 /* Compute the default load-path. */
|
617
|
3957 #ifdef CANNOT_DUMP
|
|
3958 normal = PATH_LOADSEARCH;
|
638
|
3959 Vload_path = decode_env_path (0, normal);
|
617
|
3960 #else
|
|
3961 if (NILP (Vpurify_flag))
|
|
3962 normal = PATH_LOADSEARCH;
|
|
3963 else
|
|
3964 normal = PATH_DUMPLOADSEARCH;
|
|
3965
|
|
3966 /* In a dumped Emacs, we normally have to reset the value of
|
|
3967 Vload_path from PATH_LOADSEARCH, since the value that was dumped
|
|
3968 uses ../lisp, instead of the path of the installed elisp
|
|
3969 libraries. However, if it appears that Vload_path was changed
|
|
3970 from the default before dumping, don't override that value. */
|
621
|
3971 if (initialized)
|
|
3972 {
|
|
3973 if (! NILP (Fequal (dump_path, Vload_path)))
|
4482
|
3974 {
|
|
3975 Vload_path = decode_env_path (0, normal);
|
5617
|
3976 if (!NILP (Vinstallation_directory))
|
4482
|
3977 {
|
42797
|
3978 Lisp_Object tem, tem1, sitelisp;
|
|
3979
|
|
3980 /* Remove site-lisp dirs from path temporarily and store
|
|
3981 them in sitelisp, then conc them on at the end so
|
|
3982 they're always first in path. */
|
|
3983 sitelisp = Qnil;
|
|
3984 while (1)
|
|
3985 {
|
|
3986 tem = Fcar (Vload_path);
|
|
3987 tem1 = Fstring_match (build_string ("site-lisp"),
|
|
3988 tem, Qnil);
|
|
3989 if (!NILP (tem1))
|
|
3990 {
|
|
3991 Vload_path = Fcdr (Vload_path);
|
|
3992 sitelisp = Fcons (tem, sitelisp);
|
|
3993 }
|
|
3994 else
|
|
3995 break;
|
|
3996 }
|
|
3997
|
5617
|
3998 /* Add to the path the lisp subdir of the
|
7004
|
3999 installation dir, if it exists. */
|
5617
|
4000 tem = Fexpand_file_name (build_string ("lisp"),
|
|
4001 Vinstallation_directory);
|
7004
|
4002 tem1 = Ffile_exists_p (tem);
|
|
4003 if (!NILP (tem1))
|
|
4004 {
|
|
4005 if (NILP (Fmember (tem, Vload_path)))
|
11735
|
4006 {
|
|
4007 turn_off_warning = 1;
|
42797
|
4008 Vload_path = Fcons (tem, Vload_path);
|
11735
|
4009 }
|
7004
|
4010 }
|
|
4011 else
|
|
4012 /* That dir doesn't exist, so add the build-time
|
|
4013 Lisp dirs instead. */
|
|
4014 Vload_path = nconc2 (Vload_path, dump_path);
|
11311
|
4015
|
18530
|
4016 /* Add leim under the installation dir, if it exists. */
|
|
4017 tem = Fexpand_file_name (build_string ("leim"),
|
|
4018 Vinstallation_directory);
|
|
4019 tem1 = Ffile_exists_p (tem);
|
|
4020 if (!NILP (tem1))
|
|
4021 {
|
|
4022 if (NILP (Fmember (tem, Vload_path)))
|
42797
|
4023 Vload_path = Fcons (tem, Vload_path);
|
18530
|
4024 }
|
|
4025
|
78928
|
4026 /* Add site-lisp under the installation dir, if it exists. */
|
11311
|
4027 tem = Fexpand_file_name (build_string ("site-lisp"),
|
|
4028 Vinstallation_directory);
|
|
4029 tem1 = Ffile_exists_p (tem);
|
|
4030 if (!NILP (tem1))
|
|
4031 {
|
|
4032 if (NILP (Fmember (tem, Vload_path)))
|
42797
|
4033 Vload_path = Fcons (tem, Vload_path);
|
11311
|
4034 }
|
18084
|
4035
|
|
4036 /* If Emacs was not built in the source directory,
|
18530
|
4037 and it is run from where it was built, add to load-path
|
|
4038 the lisp, leim and site-lisp dirs under that directory. */
|
18084
|
4039
|
|
4040 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
|
|
4041 {
|
18771
|
4042 Lisp_Object tem2;
|
|
4043
|
18084
|
4044 tem = Fexpand_file_name (build_string ("src/Makefile"),
|
|
4045 Vinstallation_directory);
|
|
4046 tem1 = Ffile_exists_p (tem);
|
18771
|
4047
|
|
4048 /* Don't be fooled if they moved the entire source tree
|
|
4049 AFTER dumping Emacs. If the build directory is indeed
|
|
4050 different from the source dir, src/Makefile.in and
|
|
4051 src/Makefile will not be found together. */
|
|
4052 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
|
|
4053 Vinstallation_directory);
|
|
4054 tem2 = Ffile_exists_p (tem);
|
|
4055 if (!NILP (tem1) && NILP (tem2))
|
18084
|
4056 {
|
|
4057 tem = Fexpand_file_name (build_string ("lisp"),
|
|
4058 Vsource_directory);
|
|
4059
|
|
4060 if (NILP (Fmember (tem, Vload_path)))
|
42797
|
4061 Vload_path = Fcons (tem, Vload_path);
|
18084
|
4062
|
18530
|
4063 tem = Fexpand_file_name (build_string ("leim"),
|
|
4064 Vsource_directory);
|
|
4065
|
|
4066 if (NILP (Fmember (tem, Vload_path)))
|
42797
|
4067 Vload_path = Fcons (tem, Vload_path);
|
18530
|
4068
|
18084
|
4069 tem = Fexpand_file_name (build_string ("site-lisp"),
|
|
4070 Vsource_directory);
|
|
4071
|
|
4072 if (NILP (Fmember (tem, Vload_path)))
|
42797
|
4073 Vload_path = Fcons (tem, Vload_path);
|
18084
|
4074 }
|
|
4075 }
|
42797
|
4076 if (!NILP (sitelisp))
|
|
4077 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
|
4482
|
4078 }
|
|
4079 }
|
621
|
4080 }
|
|
4081 else
|
14130
|
4082 {
|
17605
|
4083 /* NORMAL refers to the lisp dir in the source directory. */
|
|
4084 /* We used to add ../lisp at the front here, but
|
|
4085 that caused trouble because it was copied from dump_path
|
78928
|
4086 into Vload_path, above, when Vinstallation_directory was non-nil.
|
17605
|
4087 It should be unnecessary. */
|
|
4088 Vload_path = decode_env_path (0, normal);
|
14130
|
4089 dump_path = Vload_path;
|
|
4090 }
|
364
|
4091 #endif
|
|
4092
|
97043
|
4093 #if (!(defined(WINDOWSNT) || (defined(HAVE_NS))))
|
49600
|
4094 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
|
|
4095 almost never correct, thereby causing a warning to be printed out that
|
14036
|
4096 confuses users. Since PATH_LOADSEARCH is always overridden by the
|
97043
|
4097 EMACSLOADPATH environment variable below, disable the warning on NT. */
|
9790
|
4098
|
341
|
4099 /* Warn if dirs in the *standard* path don't exist. */
|
11735
|
4100 if (!turn_off_warning)
|
|
4101 {
|
|
4102 Lisp_Object path_tail;
|
341
|
4103
|
11735
|
4104 for (path_tail = Vload_path;
|
|
4105 !NILP (path_tail);
|
25663
|
4106 path_tail = XCDR (path_tail))
|
11735
|
4107 {
|
|
4108 Lisp_Object dirfile;
|
|
4109 dirfile = Fcar (path_tail);
|
|
4110 if (STRINGP (dirfile))
|
|
4111 {
|
|
4112 dirfile = Fdirectory_file_name (dirfile);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4113 if (access (SDATA (dirfile), 0) < 0)
|
16487
|
4114 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
|
25663
|
4115 XCAR (path_tail));
|
11735
|
4116 }
|
|
4117 }
|
|
4118 }
|
97043
|
4119 #endif /* !(WINDOWSNT || HAVE_NS) */
|
617
|
4120
|
|
4121 /* If the EMACSLOADPATH environment variable is set, use its value.
|
|
4122 This doesn't apply if we're dumping. */
|
11955
d972c95e7577
(init_lread) [CANNOT_DUMP]: Set Vload_path to EMACSLOADPATH.
Geoff Voelker <voelker@cs.washington.edu>
diff
changeset
|
4123 #ifndef CANNOT_DUMP
|
617
|
4124 if (NILP (Vpurify_flag)
|
|
4125 && egetenv ("EMACSLOADPATH"))
|
11955
d972c95e7577
(init_lread) [CANNOT_DUMP]: Set Vload_path to EMACSLOADPATH.
Geoff Voelker <voelker@cs.washington.edu>
diff
changeset
|
4126 #endif
|
364
|
4127 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
|
|
4128
|
|
4129 Vvalues = Qnil;
|
|
4130
|
341
|
4131 load_in_progress = 0;
|
15283
|
4132 Vload_file_name = Qnil;
|
5568
|
4133
|
|
4134 load_descriptor_list = Qnil;
|
21291
|
4135
|
|
4136 Vstandard_input = Qt;
|
31536
|
4137 Vloads_in_progress = Qnil;
|
341
|
4138 }
|
|
4139
|
16487
|
4140 /* Print a warning, using format string FORMAT, that directory DIRNAME
|
78928
|
4141 does not exist. Print it on stderr and put it in *Messages*. */
|
16487
|
4142
|
20298
|
4143 void
|
16487
|
4144 dir_warning (format, dirname)
|
|
4145 char *format;
|
|
4146 Lisp_Object dirname;
|
|
4147 {
|
|
4148 char *buffer
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4149 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4150
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4151 fprintf (stderr, format, SDATA (dirname));
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4152 sprintf (buffer, format, SDATA (dirname));
|
21736
|
4153 /* Don't log the warning before we've initialized!! */
|
|
4154 if (initialized)
|
|
4155 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
|
16487
|
4156 }
|
|
4157
|
341
|
4158 void
|
364
|
4159 syms_of_lread ()
|
341
|
4160 {
|
|
4161 defsubr (&Sread);
|
|
4162 defsubr (&Sread_from_string);
|
|
4163 defsubr (&Sintern);
|
|
4164 defsubr (&Sintern_soft);
|
11188
|
4165 defsubr (&Sunintern);
|
69170
|
4166 defsubr (&Sget_load_suffixes);
|
341
|
4167 defsubr (&Sload);
|
672
|
4168 defsubr (&Seval_buffer);
|
341
|
4169 defsubr (&Seval_region);
|
|
4170 defsubr (&Sread_char);
|
|
4171 defsubr (&Sread_char_exclusive);
|
|
4172 defsubr (&Sread_event);
|
|
4173 defsubr (&Sget_file_char);
|
|
4174 defsubr (&Smapatoms);
|
45001
|
4175 defsubr (&Slocate_file_internal);
|
341
|
4176
|
|
4177 DEFVAR_LISP ("obarray", &Vobarray,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4178 doc: /* Symbol table for use by `intern' and `read'.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4179 It is a vector whose length ought to be prime for best results.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4180 The vector's contents don't make sense if examined from Lisp programs;
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4181 to find all the symbols in an obarray, use `mapatoms'. */);
|
341
|
4182
|
|
4183 DEFVAR_LISP ("values", &Vvalues,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4184 doc: /* List of values of all expressions which were read, evaluated and printed.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4185 Order is reverse chronological. */);
|
341
|
4186
|
|
4187 DEFVAR_LISP ("standard-input", &Vstandard_input,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4188 doc: /* Stream for read to get input from.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4189 See documentation of `read' for possible values. */);
|
341
|
4190 Vstandard_input = Qt;
|
|
4191
|
45554
|
4192 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
|
|
4193 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
|
|
4194
|
|
4195 If this variable is a buffer, then only forms read from that buffer
|
|
4196 will be added to `read-symbol-positions-list'.
|
|
4197 If this variable is t, then all read forms will be added.
|
|
4198 The effect of all other values other than nil are not currently
|
|
4199 defined, although they may be in the future.
|
|
4200
|
|
4201 The positions are relative to the last call to `read' or
|
|
4202 `read-from-string'. It is probably a bad idea to set this variable at
|
|
4203 the toplevel; bind it instead. */);
|
|
4204 Vread_with_symbol_positions = Qnil;
|
|
4205
|
|
4206 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
|
47919
|
4207 doc: /* A list mapping read symbols to their positions.
|
45554
|
4208 This variable is modified during calls to `read' or
|
|
4209 `read-from-string', but only when `read-with-symbol-positions' is
|
|
4210 non-nil.
|
|
4211
|
|
4212 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
|
47919
|
4213 CHAR-POSITION is an integer giving the offset of that occurrence of the
|
45554
|
4214 symbol from the position where `read' or `read-from-string' started.
|
|
4215
|
|
4216 Note that a symbol will appear multiple times in this list, if it was
|
|
4217 read multiple times. The list is in the same order as the symbols
|
|
4218 were read in. */);
|
49600
|
4219 Vread_symbol_positions_list = Qnil;
|
45554
|
4220
|
341
|
4221 DEFVAR_LISP ("load-path", &Vload_path,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4222 doc: /* *List of directories to search for files to load.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4223 Each element is a string (directory name) or nil (try default directory).
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4224 Initialized based on EMACSLOADPATH environment variable, if any,
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4225 otherwise to default specified by file `epaths.h' when Emacs was built. */);
|
341
|
4226
|
39808
|
4227 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
|
69170
|
4228 doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
|
|
4229 This list should not include the empty string.
|
|
4230 `load' and related functions try to append these suffixes, in order,
|
|
4231 to the specified file name if a Lisp suffix is allowed or required. */);
|
39808
|
4232 Vload_suffixes = Fcons (build_string (".elc"),
|
|
4233 Fcons (build_string (".el"), Qnil));
|
69170
|
4234 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
|
|
4235 doc: /* List of suffixes that indicate representations of \
|
|
4236 the same file.
|
|
4237 This list should normally start with the empty string.
|
|
4238
|
|
4239 Enabling Auto Compression mode appends the suffixes in
|
|
4240 `jka-compr-load-suffixes' to this list and disabling Auto Compression
|
|
4241 mode removes them again. `load' and related functions use this list to
|
|
4242 determine whether they should look for compressed versions of a file
|
|
4243 and, if so, which suffixes they should try to append to the file name
|
|
4244 in order to do so. However, if you want to customize which suffixes
|
|
4245 the loading functions recognize as compression suffixes, you should
|
|
4246 customize `jka-compr-load-suffixes' rather than the present variable. */);
|
81270
0bf4e298d593
(syms_of_lread, openp): Use empty_unibyte_string, not build_string.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
4247 Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
|
39808
|
4248
|
341
|
4249 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
|
78501
|
4250 doc: /* Non-nil if inside of `load'. */);
|
341
|
4251
|
|
4252 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4253 doc: /* An alist of expressions to be evalled when particular files are loaded.
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4254 Each element looks like (REGEXP-OR-FEATURE FORMS...).
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4255
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4256 REGEXP-OR-FEATURE is either a regular expression to match file names, or
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4257 a symbol \(a feature name).
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4258
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4259 When `load' is run and the file-name argument matches an element's
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4260 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4261 REGEXP-OR-FEATURE, the FORMS in the element are executed.
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4262
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4263 An error in FORMS does not undo the load, but does prevent execution of
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4264 the rest of the FORMS. */);
|
341
|
4265 Vafter_load_alist = Qnil;
|
|
4266
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4267 DEFVAR_LISP ("load-history", &Vload_history,
|
66284
|
4268 doc: /* Alist mapping file names to symbols and features.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4269 Each alist element is a list that starts with a file name,
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4270 except for one element (optional) that starts with nil and describes
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4271 definitions evaluated from buffers not visiting files.
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4272
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4273 The file name is absolute and is the true file name (i.e. it doesn't
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4274 contain symbolic links) of the loaded file.
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4275
|
59108
|
4276 The remaining elements of each list are symbols defined as variables
|
47021
|
4277 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
|
75632
|
4278 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
|
|
4279 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
|
|
4280 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
|
|
4281 this file redefined it as a function.
|
66284
|
4282
|
66333
|
4283 During preloading, the file name recorded is relative to the main Lisp
|
|
4284 directory. These file names are converted to absolute at startup. */);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4285 Vload_history = Qnil;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4286
|
10200
|
4287 DEFVAR_LISP ("load-file-name", &Vload_file_name,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4288 doc: /* Full name of file being loaded by `load'. */);
|
10200
|
4289 Vload_file_name = Qnil;
|
|
4290
|
24817
|
4291 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4292 doc: /* File name, including directory, of user's initialization file.
|
60069
|
4293 If the file loaded had extension `.elc', and the corresponding source file
|
|
4294 exists, this variable contains the name of source file, suitable for use
|
75594
|
4295 by functions like `custom-save-all' which edit the init file.
|
|
4296 While Emacs loads and evaluates the init file, value is the real name
|
|
4297 of the file, regardless of whether or not it has the `.elc' extension. */);
|
24817
|
4298 Vuser_init_file = Qnil;
|
|
4299
|
2901
|
4300 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4301 doc: /* Used for internal purposes by `load'. */);
|
2545
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4302 Vcurrent_load_list = Qnil;
|
d666732c5f41
(readevalloop): New argument is the source file name (or nil if none).
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4303
|
11079
|
4304 DEFVAR_LISP ("load-read-function", &Vload_read_function,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4305 doc: /* Function used by `load' and `eval-region' for reading expressions.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4306 The default is nil, which means use the function `read'. */);
|
11079
|
4307 Vload_read_function = Qnil;
|
|
4308
|
17038
|
4309 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
|
73800
|
4310 doc: /* Function called in `load' for loading an Emacs Lisp source file.
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4311 This function is for doing code conversion before reading the source file.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4312 If nil, loading is done without any code conversion.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4313 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4314 FULLNAME is the full name of FILE.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4315 See `load' for the meaning of the remaining arguments. */);
|
17038
|
4316 Vload_source_file_function = Qnil;
|
|
4317
|
12780
|
4318 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4319 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4320 This is useful when the file being loaded is a temporary copy. */);
|
12780
|
4321 load_force_doc_strings = 0;
|
|
4322
|
21677
|
4323 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4324 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4325 This is normally bound by `load' and `eval-buffer' to control `read',
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4326 and is not meant for users to change. */);
|
21677
|
4327 load_convert_to_unibyte = 0;
|
|
4328
|
13601
|
4329 DEFVAR_LISP ("source-directory", &Vsource_directory,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4330 doc: /* Directory in which Emacs sources were found when Emacs was built.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4331 You cannot count on them to still be there! */);
|
14300
|
4332 Vsource_directory
|
|
4333 = Fexpand_file_name (build_string ("../"),
|
|
4334 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
|
|
4335
|
18665
|
4336 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4337 doc: /* List of files that were preloaded (when dumping Emacs). */);
|
18665
|
4338 Vpreloaded_file_list = Qnil;
|
|
4339
|
25555
|
4340 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4341 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
|
25555
|
4342 Vbyte_boolean_vars = Qnil;
|
|
4343
|
28156
|
4344 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4345 doc: /* Non-nil means load dangerous compiled Lisp files.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4346 Some versions of XEmacs use different byte codes than Emacs. These
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4347 incompatible byte codes can make Emacs crash when it tries to execute
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4348 them. */);
|
28156
|
4349 load_dangerous_libraries = 0;
|
|
4350
|
31367
|
4351 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
|
40796
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4352 doc: /* Regular expression matching safe to load compiled Lisp files.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4353 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4354 from the file, and matches them against this regular expression.
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4355 When the regular expression matches, the file is considered to be safe
|
816ced6caae8
(Feval_region): Remove obsolete #ifdef'd-out code (eval-current-buffer).
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4356 to load. See also `load-dangerous-libraries'. */);
|
31367
|
4357 Vbytecomp_version_regexp
|
31464
|
4358 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
|
28156
|
4359
|
64205
|
4360 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
|
|
4361 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
|
|
4362 Veval_buffer_list = Qnil;
|
|
4363
|
78614
|
4364 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes,
|
|
4365 doc: /* Set to non-nil when `read' encounters an old-style backquote. */);
|
|
4366 Vold_style_backquotes = Qnil;
|
78617
|
4367 Qold_style_backquotes = intern ("old-style-backquotes");
|
|
4368 staticpro (&Qold_style_backquotes);
|
78614
|
4369
|
14300
|
4370 /* Vsource_directory was initialized in init_lread. */
|
|
4371
|
5568
|
4372 load_descriptor_list = Qnil;
|
|
4373 staticpro (&load_descriptor_list);
|
|
4374
|
2901
|
4375 Qcurrent_load_list = intern ("current-load-list");
|
|
4376 staticpro (&Qcurrent_load_list);
|
|
4377
|
341
|
4378 Qstandard_input = intern ("standard-input");
|
|
4379 staticpro (&Qstandard_input);
|
|
4380
|
|
4381 Qread_char = intern ("read-char");
|
|
4382 staticpro (&Qread_char);
|
|
4383
|
|
4384 Qget_file_char = intern ("get-file-char");
|
|
4385 staticpro (&Qget_file_char);
|
2044
|
4386
|
88886
|
4387 Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char");
|
|
4388 staticpro (&Qget_emacs_mule_file_char);
|
|
4389
|
|
4390 Qload_force_doc_strings = intern ("load-force-doc-strings");
|
|
4391 staticpro (&Qload_force_doc_strings);
|
|
4392
|
11683
|
4393 Qbackquote = intern ("`");
|
|
4394 staticpro (&Qbackquote);
|
|
4395 Qcomma = intern (",");
|
|
4396 staticpro (&Qcomma);
|
|
4397 Qcomma_at = intern (",@");
|
|
4398 staticpro (&Qcomma_at);
|
|
4399 Qcomma_dot = intern (",.");
|
|
4400 staticpro (&Qcomma_dot);
|
|
4401
|
16937
|
4402 Qinhibit_file_name_operation = intern ("inhibit-file-name-operation");
|
|
4403 staticpro (&Qinhibit_file_name_operation);
|
|
4404
|
2044
|
4405 Qascii_character = intern ("ascii-character");
|
|
4406 staticpro (&Qascii_character);
|
3625
|
4407
|
13235
|
4408 Qfunction = intern ("function");
|
|
4409 staticpro (&Qfunction);
|
|
4410
|
3625
|
4411 Qload = intern ("load");
|
|
4412 staticpro (&Qload);
|
10200
|
4413
|
|
4414 Qload_file_name = intern ("load-file-name");
|
|
4415 staticpro (&Qload_file_name);
|
14130
|
4416
|
64205
|
4417 Qeval_buffer_list = intern ("eval-buffer-list");
|
|
4418 staticpro (&Qeval_buffer_list);
|
|
4419
|
70880
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4420 Qfile_truename = intern ("file-truename");
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4421 staticpro (&Qfile_truename) ;
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4422
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4423 Qdo_after_load_evaluation = intern ("do-after-load-evaluation");
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4424 staticpro (&Qdo_after_load_evaluation) ;
|
b34d05d3a567
lread.c (Vload_history): Enhance doc-string to say that the file is the
Alan Mackenzie <acm@muc.de>
diff
changeset
|
4425
|
14130
|
4426 staticpro (&dump_path);
|
16141
|
4427
|
|
4428 staticpro (&read_objects);
|
|
4429 read_objects = Qnil;
|
25165
|
4430 staticpro (&seen_list);
|
64317
|
4431 seen_list = Qnil;
|
49600
|
4432
|
31534
|
4433 Vloads_in_progress = Qnil;
|
|
4434 staticpro (&Vloads_in_progress);
|
341
|
4435 }
|
52401
|
4436
|
|
4437 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
|
|
4438 (do not change this comment) */
|