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